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PREFACE 


This  Note  documents  the  second  version  of  the  strategic  force 
allocation  model,  FALCON,  developed  by  The  RAND  Corporation  under  the 
auspices  of  the  Aerospace  and  Strategic  Technology  Program  of  Project 
AIR  FORCE.  This  version  was  created  for  the  project  "Sensitivity  of 
U.S.  Strategic  Force  Structures  to  Soviet  Cheating/Breakout  under 
START."  It  ir,  written  as  a  user's  guide  for  analysts  familiar  with  the 
issues  involved  in  allocation  of  strategic  nuclear  weapons  to  targets 
and  with  target  damage  calculations. 

FALCON  operates  on  aggregated  v;eapon  and  target  objective 
categories,  without  e.xplicit  consideration  of  geography.  It  allocates 
weapons  to  targets  by  following  an  ordered  set  of  procedures,  or  rules, 
designed  to  construct  a  realistic  allocation.  The  allocation  is  done  in 
two  passes  through  the  target  objectives:  The  first  is  designed  to 
cover  as  many  target  objectives  ns  possible  with  at  least  one 
appropriate  weapon  per  target;  the  second  co  achieve  damage  goals  not 
met  in  the  first  pass. 

Version  2  represents  a  major  extension  of  the  original  version'  in 
three  nreas:  (1)  increased  user  control  over  the  allocation  through 
additioial  rules  and  the  flexibility  to  change  rules  between  passes,  (2) 
improved  algorithms  for  selecting  the  most  appropriate  wodpon(s)  for 
allocation  to  a  target  objective,  and  (3)  additional  outputs,  including 
calculation  of  damage  expectancies  for  several  scenarios  in  a  single 
FALCON  execution. 

FALCON  should  be  of  interest  to  strategic  policy  and  weapon  systems 
analysts  concerned  with  the  evaluation  of  strategic  force  postures  or 
strategic  targeting  doctrines. 


'James  Scouras,  Claire  E.  Mitchell,  and  Mary  J.  Nissen,  FALCON:  A 
Rule-Based  Strategic  Force  Allocation  Model,  The  RAND  Corporation, 
N-2968-AF,  April  1990. 
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SUMMARY 


FALCON  (Force  ALloCatiON)  is  a  computer  model  designed  to 
allocate  strategic  nuclear  weapons  to  targets.  The  driving  forces 
behind  its  development  are  (1)  to  emphasize  realism  in  the  allocation  and 
(2)  to  strive  for  simplicity-"in  execution,  maintenance,  modification, 
and,  above  all.  Interpretation  of  results. 

The  single  most  distinguishing  feature  of  FALCON  is  that  the 
allocation  is  entirely  "rule-driven.”  An  ordered  set  of  procedures,  or 
rules,  determines  whic'  weapons  are  to  be  assigned  to  which  targets. 
Rules  range  from  the  general  (e.g.,  use  ICEMs  against  time-urgent 
targets)  to  the  specific  (e.g.,  use  one  Minuteman  II  RV  and  one  Poseidon 
C4  RV  against  SS18  silos).  Many  are  under  the  control  of  the  user;  some 
are  hardcoded. 

FALCON  operates  on  a  set  of  prioritized  target  objectives  defined 
by  the  user  as  damage-expectancy  goals  for  target  categories.  To 
construct  the  weapon-to-target  allocation,  FALCON  goes  through  these 
target  objectives  in  two  passes  following  an  initialization  of  data  and 
arrays.  The  first  pass  is  intended  to  cover  as  many  targets  as  possible 
with  one  suitable  weapon  before  a  second  weapon  is  applied  to  any  target 
(in  the  second  pass).  The  second  pass  is  designed  to  raise  damage 
levels  for  those  target  objectives  where  damage  goals  have  not  been 
reached  by  the  first  pass  allocation.' 

FALCON  is  written  in  FORTRAN  77  and  runs  on  a  personal  computer 
under  the  MS-DOS*  operating  system.'  The  source  code  occupies  300 
kilobytes  of  memory  and  the  executable  requires  a  total  of  400  kilobytes 
to  run.  On  an  IBM**  AT-compatible  computer,  moderately  complex  problems 

'FALCON  has  several  options  that  enable  the  user  to  circumvent  this 
overall  logic  to  a  limited  extent. 

*MS-D0S  is  a  trademark  of  Microsoft,  Incorporated. 

'FALCON  has  been  successfully  ported  to  other  computers  with  minor 
mcditicacions . 

‘‘IBM  is  a  trademark  of  International  Business  Machines, 
Incoroorated. 
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(20  weapon  types,  60  target  objectives)  execute  in  approximately  1.5 
minutes . 

This  model  has  been  tailored  to  the  knowledgeable  analyst.  It 

requires:  (1)  a  good  understanding  of  the  target  base,  including 
priorities,  timing  goals,  and  damage  goals;  (2)  at  least  a  general 
understanding  of  the  issues  involved  in  the  allocation  of  strategic 
nuclear  weapons  to  targets;  and  (3)  a  familiarity  with  damage 
calculations.  While  FALCON  can  make  decisions  independently  (i.e.,  all 
rules  have  default  settings),  It  is  not  intended  to  provide  a  substitute 
for  analyst  expertise  in  the  areas  of  targeting  and  weapon  allocation. 

Other  limitations  of  FALCON  include  the  following: 

•  FALCON  is  a  one-sided  model.  There  is  no  e.xplicit 
mechanism  for  the  user  to  consider  a  follow-on  retaliatory 
strike  in  the  decision  process  for  the  allocation  being 
developed. 

•  Calculations  in  FALCON  are  based  on  expected  values;  there 
is  no  provision  for  modeling  uncertainty. 

•  Geography  is  not  explicitly  modeled. 

•  FALCON  will  allocate  a  maximum  of  two  weapons  per  target. 

This  Note  documents  the  second  version  of  FALCON,  which  represents 
a  major  extension  of  the  original  version  of  FALCON  in  three  areas: 

1.  Increased  user  control  over  the  allocation  through 
additional  rules  and  the  flexibility  to  change  rules 
between  passes.  New  capabilities  include:  (a)  the  ability 
to  distinguish  between  weapons  available  on  day-to-day 
alert  and  chose  additional  weapons  available  upon  force 
generation  in  the  same  model  run;  (b)  much  greater 
flexibility  in  specifying  a  weapon  of  choice  to  be 
allocated  to  a  particular  target  objective;  (c)  the  ability 
to  model  Triad-hedging  strategies;  (d)  the  ability  to 
specify  either  mean  or  individual  target  damage  goals 
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independently  for  each  pass;  (e)  several  options  for  ■ 
selecting  weapons  on  the  basis  of  timing;  (f)  the  ability 
to  specify  a  minimum  damage  expectancy  (DE)  a  weapon  must 
achieve  to  be  allocated;  and  (g)  the  ability  to  use  target 
vulnerability  numbers  or  target  hardness  in  pounds  per 
square  inch  in  conjunction  with  user-entered  single-shot 
probability  of  kill  (SSPK)  values. 

2.  Improved  algorithms  for  selecting  the  most  appropriate 
weapon  for  allocation  to  a  target  objective.  Version  2 
reorders  all  weapons  for  each  target  objective  based  on  the 
weapon  suitability  requirements  they  meet,  flags  disallowed 
weapons,  and  then  selects  the  highest-ordered  allowed 
weapon  for  allocation. 

3.  Additional  outputs,  including  the  calculation  of  achieved 
damage  expectancies  for  four  scenarios  (day-to-day  alert, 
delayed  launch;  day-to-day  alert,  prompt  launch;  generated 
alert,  delayed  launch;  and  generated  alert,  prompt  launch) 
in  a  single  FALCON  execution.  These  damage  calculations 
are  based  on  a  single  allocation  for  one  of  these  four 
scenarios.  They  are  designed  to  evaluate  outcomes  if  the 
planning  scenario  does  not  match  the  actual  execution 
scenario.  Other  new  outputs  disolay  the  allocated  weapons 
by  timing  category  (time-urgent,  time-sensitive,  non-time- 
sensitive)  versus  the  timing  category  of  the  targets. 


Many  other,  more  subtle,  improvements  were  made  to  correct  bugs, 
make  the  program  more  "user-friendly,"  ind  manage  memory  more 
efficiently . 
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I.  INTRODUCTION 


FALCON  (Force  ALloCatiON)  is  a  computer  model  designed  to 
allocate  strategic  nuclear  weapons  to  targets.  It  has  been  tailored  to 
the  knowledgeable  analyst  with  (1)  a  good  understanding  of  the  target 
base,  including  priorities,  timing  goals,  and  damage  goals;  (2)  at  least 
a  general  understanding  of  the  issues  involved  in  the  allocation  of 
strategic  nuclear  weapons  to  tar<»ets;  and  (3)  a  familiarity  with  damage 
calculations.  While  FALCON  can  make  decisions  independently  (i.e.,  all 
rules  have  default  settings),  it  is  not  intended  to  provide  a  substitute 
for  analyst  expertise  in  the  areas  of  targeting  and  weapon  allocation. 

To  understand  FALCG'I,  it  is  important  to  distinguish  force 
allocation  and  damage  prediction.  In  developing  an  attack  plan 
(assigning  weapons  to  targets),  targeteers  must  estimate  the  damage 
these  weapons  are  likely  to  do.  This,  in  turn,  requires  operating 
assumptions  about  the  scenario  in  which  the  weapons  will  be  used, 
estimation  of  numerous  offensive  and  defensive  weapon  performance 
parameters,  target  characteristics,  etc.  Of  course,  targeteers' 
operating  assumptions  will  not  necessarily  correspond  to  reality.  In 
fact,  they  might  intentionally  deviate  from  reality  to  be  conservative 
or  to  simplify  the  problem  to  manageable  proportions.  Thus,  the  actual 
damage  achieved  may  be  very  different  from  that  estimated  for  the 
purpose  of  facilitating  the  allocation  process. 

FALCON  is  therefore  properly  termed  a  force  allocation  model;  it  is 
not  designed  principally  to  predict  target  damage.  The  damages 
estimated,  used,  and  reported  by  FALCON  should  be  considered 
analytically  convenient  surrogates  to  actual  damages  whose  purpose, 
again,  is  merely  to  facilitate  the  development  of  the  allocation.  Even 
if  accurate  information  were  used  in  planning  the  allocation,  FALCON 
damage  prediction  capability  is  limited  by  its  level  of  modeling  detail, 
lack  of  consideration  of  random  phenomena,  and  other  factors. 


-  2  - 


FEATURES 

FALCON  was  developed  to  fill  a  particular,  but  important,  niche  in 
the  spectrum  of  possible  strategic  exchange  models  by  (1)  emphasizing 
realism  in  the  allocation  and  (2)  striving  for  simplicity-in  execution, 
maintenance,  modification,  and,  above  all,  interpretation  of  results. 
These  driving  forces  have  led  directly  to  a  rule-based  approach  to 
weapon  allocation  and,  less  directly,  to  a  decision  to  code  FALCON  in 
FORTRAN  77  and  implement  it  on  a  personal  computer. 

The  single  most  distinguishing  feature  of  FALCON  is  that  the 
allocation  is  entirely  "rule-driven,"  An  ordered  set  of  procedures,  or 
rules,  determines  which  weapons  are  to  be  assigned  to  which  targets. 
falcon's  rule-driven  approach  may  be  contrasted  to  the  approach  used  by 
"optimizing"  models,  which  rely  on  an  objective  function--e.g. ,  total 
target  value  destroyed.  The  allocations  defined  by  these  models  are 
those  that  maximize  or  minimize  this  function.  Although  optimizing 
models  may  be  elegant  in  structure,  they  can  generate  allocations  that 
do  not  reflect  reality.  Constraints  on  the  allocation  are  often  imposed 
to  rectify  this  problem,  but  they  are  generally  limited  in  their  form 
and  provide  indirect  control.  Rule-based  allocations  can  provide  the 
analyst  with  more  direct  control  over  the  allocation  with,  at  least  in 
theory,  the  potential  for  a  greater  degree  of  realism. 

FALCON  is  written  in  FORTRAN  77  and  runs  on  a  personal  computer 
under  the  MS-DOS  operating  system,  FORTRAN  77  has  the  principal 
advantages  of  being  mathematically  oriented,  having  published  standards, 
and  being  widely  known  and  available.  In  addition,  some  important 
public  domain  subroutines  that  FALCON  incorporates  are  available  in 
FORTRAN.  The  source  code  occupies  300  kilobytes  of  memory  and  the 
executable  requires  a  total  of  400  kilobytes  to  run.  On  an  IBM 
AT-compatible  computer,  moderately  complex  problems  (20  weapon  types,  60 
target  objectives)  execute  in  approximately  1.5  minutes. 

Development  work  on  FALCON  is  continuing.  The  nature  of  these 
developments  is  heavily  dependent  on  the  modeling  needs  of  studies 
currently  being  undertaken  at  RAND.  Other  researchers  who  exercise 
FALCON  are  encouraged  to  suggest  improvements  so  that  future  versions 
might  benefit  from  their  experiences  as  well. 
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LIMITATIONS 

It  is  much  more  efficient  to  describe  the  limited  set  of  things 
that  a  model  does  rather  than  the  unlimited  set  of  things  it  does  not 
do.  Nevertheless,  we  describe  what  we  consider  to  be  the  major 
limitations  of  FALCON.  Many  of  these  stem  from  our  insistence  on 
simplicity  for  ease  of  use  and  understandability  of  results.  Others  are 
limitations  we  intend  to  remove  in  future  versions. 

One  major  limitation  applies  to  rule-based  models  in  general.  It 
is  very  difficult,  if  not  impossible,  to  model  all  applicable  thought 
processes  of  a  targeteer  as  rules.  To  maintain  simplicity,  many  complex 
rules  have  not  been  modeled. 

FALCON  is  a  one-sided  model.  There  is  no  explicit  mechanism  for 
the  user  to  consider  a  follow-on  retaliatory  strike  in  the  decision 
process  for  the  allocation  being  developed.  Of  course,  the  user  can 
implicitly  account  for  the  retaliation  in  setting  priorities  and  timing 
and  damage  goals  for  the  one-sided  allocation. 

Calculations  in  FALCON  are  based  on  expected  values.  There  is  no 
provision  for  modeling  uncertainty  due  to  imperfect  knowledge  of  weapon 
performance  parameters  and  target  characteristics  or  due  to  stochastic 
processes.  The  user  can  account  for  these  uncertainties  to  some  extent 
by  being  conservative  in  the  values  he  uses  to  develop  the  allocation. 

Geography  is  not  explicitly  modeled.  FALCON  does  not  consider 
issues  related  to  target  collocation,  weapon  system  range,  footprint 
constraints,  etc. 

FALCON  will  allocate  a  maximum  of  two  weapons  per  target.  This  is 
not  a  serious  limitation  where  defenses  are  not  highly  effective  and 
there  is  not  a  great  excess  of  weapons  over  targets,  as  is  the  case  in 
1990.  However,  these  conditions  may  not  pertain  to  the  future. 

DESCRIPTION 

Section  II  presents  an  overview  of  FALCON.  Section  III  provides  a 
detailed  accounting  of  FALCON 's  logic  and  structure.  The  mechanics  of 
running  FALCON  are  described  in  Sec.  IV  by  means  of  an  example  model 


run. 
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Appendix  A  contains  descriptions  of  all  subroutines,  including  the 
rr-ucture  of  the  calling  sequence.  Appendix  B  contains  descriptions  of 
all  variables  in  common  blocks.  Appendix  C  contains  compiling  and 
linking  instructions.  An  example  debug  output  file  (for  the  example 
model  run  of  Sec.  IV)  is.  provided  in  Appendix  D.  Appendix  E  contains 
notes  for  increasing  or  decreasing  array  dimensions.  Appendix  F 
contains  the  FORTRAN  source  code. 
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II.  OVERVIEW 


FALCON  operates  on  a  set  of  prioritized  target  objectives  defined 
by  the  user  as  damage  expectancy  goals  for  target  categories.  As  shown 
in  Fig.  1,  to  develop  the  allocation  FALCON  goes  through  these 
objectives  in  two  passes  following  an  initialization  of  data  and  arrays. 

Initialization  accomplishes  three  major  functions.  First,  all 
input  data  are  read.  Second,  the  list  of  allocatable  weapons  is  created 
when  availability  factors  are  applied  to  the  deployed  quantities  of 
weapons,  the  weapon  reserve  is  set  aside,  and  alert  (and  prelaunch 
survivability,  if  the  user  so  chooses)  factors  are  applied  to  the 
unreserved  available  weapons.  Finally,  the  damage  expectancy  is 
determined  for  each  weapon  versus  each  target  category. 

The  first  pass  is  intended  to  cover*  as  many  targets  as  possible 
with  one  suitable  weapon  before  allocating  a  second  weapon  to  any  target 
(in  the  second  pass).  However,  FALCON  also  provides  the  capability  of 
allocating  up  to  two  weapons  per  target  in  this  first  pass.  If  the  user 
has  specified  a  weapon  (or  weapons)  for  the  allocation  (termed 
"weapon(s)  of  choice"),  FALCON  uses  this  (these)  if  available. 

Otherwise,  in  deciding  which  weapon  to  allocate  to  a  particular  target 
objective,  FALCON  first  orders  all  of  the  allocatable  weapons  by  the 
characteristics  of  mobility,  time  urgency,  alert  rate,  damage 
expectancy,  and  priority.  Weapons  disallowed  because  of  failure  to  meet 
certain  operational  suitability  criteria  are  flagged.  The  first  allowed 
weapon  in  the  ordered  list  is  selected  for  allocation.  The  appropriate 
numbers  of  weapons  are  allocated,  damages  calculated,  and  arrays  updated 
before  FALCON  proceeds  to  the  next  target  objective. 

After  all  target  objectives  have  been  processed  FALCON  continues 
with  the  second  pass,  which  is  designed  to  raise  damage  levels  for  those 
target  objectives  where  both  (1)  damage  goals  have  not  been  achieved  and 
(2)  fewer  than  two  weapons  per  target  have  been  allocated  in  the  first 

*By  "cover  targets"  we  mean  "allocate  at  least  one  weapon  per 
target . " 
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Fig.  1 — FALCON  program  flow  overview 
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pass.  As  in  the  first  pass,  weapons  are  ordered  and  disallowed  weapons 
flagged;  however,  weapon  ordering  based  on  time  urgency  may  be  bypassed 
or  replaced  by  a  Triad-hedging  strategy  in  the  second  pass.  Additional 
weapons  are  applied  to  the  target  objectives  until  either  (1)  the 
maximum  of  two  weapons  p-vr  target  for  both  passes  has  been  reached  or 
(2)  the  damage-expectancy  goal  has  been  achieved. 

FALCON  allocation  will  stop  when  any  one  or  more  of  these  criteria 
are  met: 

•  All  allocatable  weapons  have  been  allocated. 

•  All  damage  goals  have  been  met. 

•  Two  weapons  have  been  allocated  to  each  target. 

•  No  remaining  allocatable  weapons  are  allowed  for  unmet  target 
objectives . 

The  rationale  behind  the  last  two  of  these  stopping  rules  is  that  it  is 
more  realistic  to  reserve  more  weapons  or  find  other  targets  than  to 
allocate  many  weapons  to  any  single  target  or  to  apply  unsuitable 
weapons  to  targets.  Thus  FALCON  allocation  may  end  with  both 
unallocated  weapons  and  unmet  objectives. 
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III.  FALCON  LOGIC 


FALCON  allocates  weapons  to  targets  in  three  basic  steps: 

•  An  initialization  step  to  read  input  data  and  prepare  necessary 
arrays . 

•  A  first  pass  allocation  to  cover  targets  while  trying  to  meet 
the  damage-expectancy  goals  cf  each  target  objective. 

•  A  second  pass  allocation  to  increase  the  damage  expectancy  for 
target  objectives  where  the  damage-expectancy  goal  is  not  met, 
while  trying  (if  the  user  chooses)  to  hedge  against  unexpected 
failure  of  one  leg  of  the  Triad. 

These  steps  are  illustrated  in  Figs.  2  through  4  and  are  described 
below. 

INITIALIZATION 

The  initialization  step,  shown  in  Fig.  2,  consists  of  reading  input 
data,  calculating  allocatable  weapons,  and  determining  the  damage- 
expectancy  matrix  for  each  weapon  against  each  target  category. 

Reading  Input  Data 

Input  data  for  FALCON  consist  of  weapons  data  and  target  objectives 
data  and  rules  to  be  applied  to  both  program  flow  and  to  the 
allocation. ' 


Weapons  Data 

The  weapons  data  are  contained  in  a  text  file  named  by  the  user. 
The  weapons  data  portion  of  this  file  is  shown  in  Table  1  (a  more 
complete,  commented  version  of  this  file  is  shown  in  Fig.  7  below  (Sec. 
IV).  For  eacn  weapon  this  file  contains  the  following  data: 


*An  optional  third  input  data  file,  containing  single-shot 
probability  of  kill  (SSPK)  values,  is  read  when  needed  during  the 
process  of  determining  the  DE  matrix  later  in  the  initialization  step. 


Fig  2 — Initialization 
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•  Weapon  name . 

•  Weapon  type. 

-  SILO,  RAIL,  OR  ROAD  for  ICBM  weapons 

-  PORT  (for  in  port),  SEA  (for  at  sea),  OR  STA  (for  on  station) 
for  SLBM  weapons 

-  ALCM  (air-launched  cruise  missile),  GRAV  (gravity  bomb),  or 
SRAM  (short-range  attack  missile)  for  AIR  weapons 

•  Triad  leg. 

-  I  for  ICBM  (intercontinental  ballistic  missile) 

-  S  for  SLBM  (submarine-launched  ballistic  missile) 

-  A  for  AIR  (air  weapon) 

•  Weapon  priority. 

•  Designation  for  capability  against  mobile  targets. 

-  M  if  capable  against  mobile  targets 

-  F  or  blank  if  not  capable  against  mobile  targets 

•  Time-urgency  capability.* 

-  1  for  time-urgent-capable  weapons 

-  2  for  time-sensitive-capable  weapons 

•  3  for  nontime-sensitive-capable  weapons 

Table  1 

SAMPLE  WEAPONS  DATA  FROM  WEAPONS  DATA  FILE 


—  —  —  —  —  . .  .  .  .  .  . 

c  L  M  u  ru 

c  e  o  R  WITHHOLD  AUHT  DAY 

CMAME  TYTC  C  TRI  i  C  OU  AVAIL  VH  W  DAY  CRN  OCL 

.  —  -  •  — -  — —  — —  •••• 

MHtXI  SILO  I  I  1  400  0.9S  0  0.00  0.40  l.OO  0.40 

SICBH  SILO  I  3  I  2S0  0.90  10  0.00  0.99  0.9S  O.SO 

MX  RAIL  I  2  1  300  0.90  0  0.00  O.SS  1.00  0.40 

D-SH  STA  S  4  2  SSO  0.10  0  0.00  0.90  0.99  0.40 

B-1R9  CRAV  A  7  M  3  430  0.99  0  0.30  0.40  0.40  0.40 


fis 

fLS 

ru 

PTP 

PTP 

PTP 

PTP 

DAY 

QIH 

cew 

MLIABILITUS  DAY 

DAY 

CEN 

CEM 

fRL 

DtL 

RRL 

RSLL  ULI  RtU  DEL 

PRL 

DEL 

PRL  YIX  CEP 

0.40  0.40  1.00  0.10  1.00  1.00  1.00  1.00  1.00  1.00  300  ICC: 
0.40  0.90  1.00  0.40  0.90  1.00  1.00  1.00  1.00  1.00  390  40: 
0.70  0.90  0.90  0.90  0.90  1.00  1.00  1.00  1.00  1.00  3C0  40 
0.70  0.90  0.90  0.90  0.90  1.00  1.00  1.00  1.00  1.00  300  9Ci 
0.70  0.90  0.90  0.90  0.90  1.00  0.70  0.40  0.40  0.90  1009  19C 


*rnree  categories  of  time  urgency  are  available  to  the  user;  time- 
urgent,  time-sensitive,  and  nontime-sensitive  with  codes  1,  2,  and  3, 
respectively.  The  user,  however,  can  interpret  these  categories  as 
appropriate  to  his  application,  provided  the  weapon  timing  capabilities 
and  target  objective  timing  requirements  are  interpreted  in  a  consistent 
manner. 
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•  Number  of  weapons  deployed. 

•  Fraction  of  deployed  weapons  available. 

•  Number  of  weapons  to  withhold. 

•  Percentage  of  weapons  to  withhold  (in  addition  to  the  number  of 
weapons  specified  above) 

•  Day-to-day  alert  rate. 

•  Generated  alert  rate. 

•  Prelaunch  survivabilities  for 

-  Day-to-day  alert,  delayed- launch  scenario 

-  Day-to-day  alert,  prompt-launch  scenario 

-  Generated  alert,  delayed- launch  scenario 

-  Generated  alert,  prompt- launch  scenario. 

•  Launch  reliability. 

•  In-flight  reliability. 

•  Warhead  reliability. 

•  Probability  to  penetrate  for 

-  Day-to-day  alert,  delayed- launch  scenario 

-  Day-to-day  alert,  prompt-launch  scenario 

-  Generated  alert,  delayed- launch  scenario 

-  Generated  alert,  prompt-launch  scenario. 

•  Yield  (in  kilotons). 

•  CEP  (circular  error  probable,  in  feet). 

Various  erroneous  inputs  in  the  weapons  data  will  cause  FALCON  to 
stop:  (1)  Too  many  weapon  types  are  input,  (2)  the  weapon  priority  is 

greater  than  100  or  less  than  1,  (3)  a  CEP  or  yield  of  zero  is  input, 

(4)  the  generated  alert  rate  is  less  than  the  day-to-day  alert  rate  for 
any  weapon,  (5)  the  named  weapons  input  file  is  not  found,  or  (6)  the 
weapons  data  are  formatted  incorrectly. 
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Target  Objectives  and  Data  Rules 

The  second  input  text  file  named  by  the  user  contains  the  remaining 
data  required  to  set  up  the  allocation  problem:  rules  governing  the 
program  flow  and  allocation,  and  target  objectives  data. 

FALCON  uses  rules  to  govern  both  program  flow  and  the  allocation. 
These  rules  are  either  coded  into  the  logic  or  are  selected  by  the  user. 
The  rules  that  are  embedded  within  FALCON  logic  (not  subject  to  user 
control  and  therefore  not  entered  in  the  target  objectives  and  rules 
data  file)  are: 

•  No  more  than  two  weapons  per  target  are  allocated  by  the  end  of 
the  second  pass. 

•  All  probabilities  are  independent. 

•  Allocation  will  stop  when  (1)  allocatable  weapons  are  depleted, 
(2)  all  target  objective  damage-expectancy  goals  have  been 
reached,  (3)  two  weapons  have  been  allocated  to  every  target, 
(4)  no  allowable  weapons  remain  for  unmet  objectives,  or  (5) 
the  total  number  of  allocations’  exceeds  the  allowable  maximum 
(three  times  the  maximum  number  of  target  objectives). 


Rules  under  user  control  can  be  categorized  as  governing  program 
flow,  including  input  selection,  or  governing  the  allocation.  The  user 
sets  these  rules  in  the  target  objectives  and  rules  data  file  (shown  in 
detail  in  the  following  section).  The  rules  governing  program  flow  and 
input  selection  describe: 

•  Alert  rate  (generated  or  day-to-day). 

•  For  generated  alert,  whether  to  distinguish  weapons  on  day- 
to-day  alert  from  weapons  additionally  available  upon 
generation. 

•  Launch  strategy  (prompt- launch  or  delayed- launch) . 


’An  "allocation"  consists  of  an  assignment  of  each  set  of  weapons 
or  weapon  pairs  to  a  subset  of  targets.  For  example,  if  50  Minuteman  II 
are  allocated  to  50  of  100  0MT_red  targets  and  50  B-lBg  paired  with  50 
small  ICBM  are  allocated  to  the  remaining  50  targets,  this  target 
objective  is  considered  to  have  two  "allocations,"  the  first  using  50 
single  weapons,  the  second  using  50  weapon  pairs. 
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•  Whether  the  SSPK  values  will  be  entered  by  the  user,  calculated 
by  formula,  calculated  using  PDCLC4,  or  a  combination  of  the 
first  and  one  of  the  latter  two. 

•  Whether  the  prelaunch  survivability  factor  is  to  be  used  to 
reduce  the  number  of  allocatable  weapons  or  used  to  degrade  the 
damage  expectancy. 

•  The  degree  of  printed  output.,  specifically: 

-  The  degree  of  diagnostic  output  printed  to  the  audit  trail 
(none,  moderate,  full). 

-  The  range  of  objectives  for  which  diagnostic  output  is  to  be 
printed. 

-  Whether  results  for  cross  cases  (scenarios  other  than  the 
allocation  scenario)  are  to  be  printed. 

Rules  governing  the  allocation  describe: 


For  Pass  1  only 

-  Whether  to  relax  the  requirement  to  use  the  weapon (s) 

of  choice.  If  this  rule  cannot  be  relaxed  and  no  weapon(s)  of 
choice  are  available,  no  weapon  will  be  allocated. 

”  Whether  to  sort  weapons  (1)  by  specific  timing  capability  (time- 
urgent,  time-sensitive,  or  nontime-sensitive)  of  the  weapons 
relative  to  the  timing  requirement  of  the  target  objective  or 
(2)  by  whether  they  meet  the  target  objective  timing  requirement 
(yes  or  no) . 

For  Pass  2  only 

-  Whether  to  turn  off  Pass  2.  No  additional  weapons  would  be 
allocated  in  Pass  2  if  it  were  turned  off. 

-  Whether  weapons  are  to  be  ordered  by  Triad  leg,  timing,  or 
neither. 

-  If  weapons  are  ordered  by  Triad  leg, 

--  Whether  to  allow  a  second  weapon  from  the  same  Triad 
leg  as  the  first  weapon. 

--  Whether  to  allow  the  second  weapon  to  be  the  same 
weapon  as  the  first  weapon. 

For  both  Pass  1  and  Pass  2  independently 

-  Whether  the  final  ordering  of  weapons  is  to  be  by  damage 
expectancy  or  by  weapon  priority. 

-  Whether  the  DE  goal  to  be  met  is  a  mean  DE  goal  or  an 
individual  DE  goal.** 


‘‘For  a  mean  DE  goal,  the  DE  must  be  achieved  as  an  average  DE  of 
all  the  targets  in  the  objective.  For  an  individual  DE  goal,  the  DE 
must  be  met  by  each  target  in  the  objective. 
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-  Whether  to  allow  mobile-capable  weapons  to  be  used  against 
fixed  targets. 

-  Whether  to  allow  nonmobile-capable  weapons  to  be  used 
against  mobile  targets, 

-  Whether  the  time-urgency  requirement  may  be  relaxed. 

-  Whether  the  damage -expectancy  goal  may  be  relaxed. 


The  target  objectives  data  portion  of  this  file  is  shown  in  Table 
2.  The  file  is  shown  in  its  entirety  in  Fig.  8  below  (Sec.  IV).  For 
each  target  objective  the  following  data  are  specified: 

•  Target  priority. 

•  Target  name  (12  characters,  the  first  three  of  which  should  be 
one  of  the  following  target  class  designations:  "NUC",  "LDP.'  , 
"OMT",  "ECN",  or  "DEF"  for  "Nuclear",  "Leadership",  "Other 
Military  Targets",  "Economic"  and  "Defense",  respectively.) 

•  Number  of  targets. 

•  Designation  for  target  mobility. 

-  M  for  mobile  targets 

-  F  or  blank  for  fixed  targets 

•  The  probability  of  target  detection  (1.0  or  blank  for  nonmobile 
targets),  used  to  reduce  the  number  of  r.argets  to  which  a 
weapon  is  allocated. 

•  Time-urgency  requirement. 

-  1  for  time-urgent  targets 

-  2  for  time-sensitive  targets 


Table  2 

SAMPLE  TARGET  OBJECTTIVES  DATA  FROM  THE  TARGET 
OBJECTIVES  AND  RULES  DATA  FILE 
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-  3  for  nontime-sensitive  targets 

•  R95,  the  radius  (in  nautical  miles)  of  a  circle  containing  95 
percent  of  the  target  area.  For  equivalent  target  area  (eta) 
targets  (types  A,  B,  C,  D,  or  E)  R95xl0  equals  the  orientation 
of  the  target  in  degrees. 

•  The  azimuth  in  degrees  from  the  designated  ground  zero  (DGZ)  to 
the  target  (used  only  for  eta  targets) 

•  Offset,  the  distance  (in  nautical  miles)  between  the  target  and 
the  aimpoint. 

•  Vulnerability  number  (VNTK)*  for  the  target  objective  (when 
ISSPK  =  3  or  5)  or  hardness  of  the  target  in  pounds  per  square 
inch  (psi)  when  SSPK  is  to  be  calculated  (ISSPK  =  2  or  ISSPK  = 
A).  Note  that  values  cannot  be  mixed:  All  targets  must  use  a 
vulnerability  number  or  all  must  use  hardness  in  psi. 

•  Height-of-burst  (in  feet--a  -1  specifies  optimum  height  of 
burst  (HOB)). 

•  Pass  1  damage-expectancy  goals. 

•  Pass  2  damage -expectancy  goals. 

•  The  weapon  or  weapons  of  choice.  The  user  may  select  one  or 
two  preferred  single  weapons,  or  a  preferred  pair  of  weapon  i, 
for  allocation  to  a  target  objective.  The  weapon  may  be 
specified  by  the  Triad  leg  (e.g.  "AIR"),  the  weapon  type  (e.g. 
"silo"),  or  as  a  particular  weapon  (e.g.  "MMIl"),  or  the 
negation  of  any  of  these  (e.g.  "NOT.SILO"). 

•  The  requirement  to  conduct  Pass  2  for  the  current  target 
objective  before  allocating  weapons  to  the  next  target 
objective  in  Pass  1.  If  this  requirement  is  set  for  an 
objective,  up  to  two  weapons  per  target  will  be  allocated  in 
Pass  2  to  the  current  target  objective  before  allocating  any 
weapons  to  the  next  objective.  A  "*"  in  the  target  objectives 
data  line  indicates  that  this  requirement  is  to  be  met;  a  blank 
indicates  it  is  not  to  be  met. 

•  The  minimum  DE,  if  any,  for  a  weapon  to  be  allocated  to  a 
target.  If  this  value  is  specified,  weapons  will  not  be 

®For  an  explanation  of  the  VNTK  system  for  characterizing  the 
susceptibility  of  targets  to  the  effects  of  nuclear  weapons,  see  Defense 
Intelligence  Agency,  Mathematical  Background  and  Programming  Aids  for 
the  Physical  Vulnerability  System  for  Nuclear  Weapons,  DI -550-27-74, 
November  1974. 
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allocated  to  this  target  unless  their  weapon-to-target  DE 
exceeds  that  of  the  minimum  DE  specified.  If  the  minimum  DE  is 
not  specified,  it  is  assumed  to  be  zero. 


Various  erroneous  inputs  in  the  targets  data  will  cause  FALCON  to 
stop  execution.  Program  execution  will  stop  when  (1)  the  target 
hardness  is  zero,  (2)  an  illegal  VNTK  is  entered  (specifically  a  target 
with  a  "T"  value  of  "G",  "J",  or  '*K"  is  entered),  (3)  too  many  target 
types  are  specified,  (4)  two  targets  have  duplicate  priorities,  (5) 
targets  have  priorities  less  than  1  or  greater  than  999,  (6)  the  named 
targets  file  is  not  found,  or  (7)  the  target  objectives  and  rules  data 
are  not  formatted  correctly. 

Calculating  Allocatable  Weapons 

Initialization  continues  with  the  determination  of  allocatable 
weapons,®  This  is  done  by  first  reducing  the  number  of  weapons  deployed, 
as  input,  by  the  weapon  availability  fraction: 

Available  Weapons  =  (Deployed  Weapons)  x  (Availability  Fraction). 

Weapon  reserves  are  then  set  aside  by  the  user's  specifying  which 
weapon  types,  numbers,  and  additional  percentages  to  withhold.  The 
reserve  is  taken  directly  out  of  the  available  weapons: 

Single  Integrated  =  (Available  Weapons  -  Number  of  Weapons 

Operational  Plan  (SIOP)  to  Withhold)  x  (1  -  Percentage  of 

Available  Weapons  Weapons  to  Withhold), 


FALCON  next  accounts  for  losses  due  to  alert  rates,  either 
generated  or  day-to-day.  If  the  user  has  chosen  to  account  for 
prelaunch  survivability  in  the  calculation  of  damage  expectancy,  then 


®For  this  model,  "allocatable"  means  all  weapons  that  are  available 
for  allocation--deployed  weapons  less  any  weapons  unavailable,  withheld, 
or  not  alert.  "Allowable"  means  allocatable  weapons  that  additionally 
meet  the  mobility,  timing,  damage  expectancy,  and  Triad-hedging 
requirements  for  a  target  objective. 
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Allocatable  Weapons  =  (SIOP  Available  Weapons)  x  (Alert  Rate). 

Alternatively,  if  the  user  has  chosen  to  account  for  prelaunch 
survivability  by  reducing  the  number  of  allocatable  weapons,  then 

Allocatable  Weapons  =  (SIOP  Available  Weapons)  x  (Alert  Rate) 

X  (Prelaunch  Survivability). 

As  the  last  step  in  determining  allocatable  weapons,  FALCON  checks 
whether,  for  generated  alert  scenarios,  the  weapons  are  to  be 
differentiated  by  alert  rate.  If  so,  FALCON  determines  how  many  of  the 
weapons  on  generated  alert  would  have  been  available  on  day-to-day 
alert.  For  example,  of  100  allocatable  MX  weapons  with  a  day-to-day 
alert  rate  of  50  percent  and  a  generated  alert  rate  of  90  percent,  the 
number  of  weapons  on  day-to-day  alert  will  be  50  and  an  additional  40 
will  be  available  upon  generation.  In  the  generated  alert  scenario, 
FALCON  denote.^  this  distinction  by  prefixing  the  weapons  that  would  have 
been  availa'  ■  on  day-to-day  alert  with  a  "d_"  and  the  additional 
weapons  available  upon  generation  with  a  ”g_".  So,  there  would  be  50 
d_MX  and  40  g_MX  allocatable  weapons  in  this  example. 

If  weapons  are  differentiated  by  alert  rate,  preference  in  the 
first  pass  allocation  is  provided  to  those  weapons  that  would  have  been 
available  on  day-to-day  alert.  Additionally,  if  a  generated  weapon  was 
allocated  to  a  particular  target  in  the  first  pass,  preference  will  be 
given  in  the  second  pass  to  allocating  a  day-to-day  weapon  to  the  same 
target . 

Determining  the  DE  Matrix 

This  portion  of  the  initialization  is  accomplished  by  (1)  using 
SSPK  values  as  input  by  the  user  in  the  file  SSPK.DAT  (see  Fig.  9  in 
Sec.  IV),  (2)  calculating  the  SSPKs  by  formula,  (3)  using  the 
subroutine  PDCLC4  to  determine  the  SSPK  for  each  weapon/target 
combination,  or  (4)  combining  (1)  with  (2)  or  (3). 
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When  the  user  inputs  SSPK  values,  the  user  must  be  careful  to 
ensure  weapon  and  target  names  in  the  input  table  exactly  match  those  in 
the  weapons  and  target  objectives  and  rules  data  files.  FALCON 
execution  will  terminate  if  the  SSPK  file  can  not  be  found  or  if  the 
SSPK  data  are  incorrectly  formatted. 

When  SSPK  values  are  calculated  by  formula,  the  user  must  be  sure 
to  enter  the  hardness  (in  psi)  in  the  VNTK  column  of  the  targets  data 
file.  The  formula  used  is:’ 


SSPK  =  1.  -  0.5^^  ^  (LR/CEP)  ] 

where  Y  =  yield  in  kilotons 

CEP  =  circular  error  probable  in  feet 
LR  =  lethal  radius  in  feet 
=  1000  (3.48  *  (12.1  *  3.3  » 

where  H  •  target  hardness  In  psl. 


When  the  SSPK  is  to  be  calculated  using  PDCLC4,  the  user  may  choose 
the  HOB  to  use  for  each  weapon.  Alternatively,  FALCON  will  calculate 
the  optimum  HOB  (one  chat  maximizes  the  SSPK)  if  desired.  When  using 
PDCLC4,  the  user  should  be  aware  of  the  restrictions  and  limits  that 
apply  to  the  vulnerability  number  (VNTK): 

•  In  the  target  objectives  and  rules  data  file,  the  VNTK  must  be 
right- justified  in  the  appropriate  column.  For  example,  a  VNTK 
of  "9P0"  must  appear  right-hand  justified  as  "  9P0". 

•  PDCLC4  handles  only  upper  case  "T"  values  of  the  VNTK;  however, 
the  calling  routine,  PDCALC,  checks  for  lower  case  and  converts 
to  upper  case  as  necessary.  Thus  the  user  may  enter  upper  or 
lower  case  "T"  values. 


’Bruce  W.  Bennett,  Assessing  the  Capabilities  of  Strategic  Nuclear 
Force:  The  Limits  of  Current  Methods^  The  RAND  Corporation,  N-1441-NA, 
June  1980. 
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•  PDCLC4  will  not  handle  "T”  values  of  "G",  "J",  or  "K".  PDCALC 
checks  for  these  values,  and  if  they  are  found,  prints  an  error 
message  to  the  screen  and  terminates  execution. 

•  If  the  optimum  HOB  is  to  be  calculated  and  the  target  is  a 
"P"-type  target  ("T"  =  "V",  "W",  "X",  "Y",  or  "Z"),  PDEXEC  sets 
the  HOB  to  zero. 


Once  SSPK  values  are  determined,  the  user  degrades  these  values  in 
calculating  damage  expectancy  by  accounting  for  prelaunch  survivability 
(if  this  has  not  been  accounted  for  by  reducing  the  number  of 
allocatable  weapons),  weapon  system  reliability,  and  probability  of 
penetrating  defenses.  The  formula  for  damage  expectancy  of  a  single 
weapon  against  a  target  can  be  expressed  as: 

DE  =  ((PLS)*REL‘PTP1«SSPK 


where 


DE  =  Damage  expectancy 

PLS  =  Pre launch  survivability 

REL  =  Weapon  system  reliability 

(the  product  of  the  launch,  in-flight, 
and  warhead  reliabilities) 

PTP  =  Probability  to  penetrate  defenses 
SSPK  =  Single-shot  probability  of  kill. 


Values  of  zero  for  DE  are  not  allowed  and  result  in  termination  of 
FALCON  execution.  DEs  for  weapon  pairs  are  obtained  with  the  formula: 


DE^  2  =  1  -  (1  -  DEj)(l  -  DE^), 

where  DEj^  and  DE2  are  the  damage  expectancies  of  the  two  individual 
weapons  against  the  target  in  question,  and  DE.  „  is  the  damage 

1  >  4 

expectancy  of  the  pair  of  weapons  against  this  target. 

FIRST  PASS  ALLOCATION 

After  initialization  has  been  completed,  FALCON  proceeds  in  Pass  1 
to  evaluate  each  target  objective  in  priority  order  (Fig.  3).  FALCON 
does  this  by: 


/Another\No 

spbjective?/*^ 


Pass  2 
^  Start  > 


'WeaponsS^ 
\  left?  / 


Order  weapons; 
Flag  disallowed  weapons 


Veapon(s)  Select  the  weapon(s)  of 

choice  /  choice  for  allocation 
sspecified?/  - - 


Write 
results  to 
output 
files 


Select  the  first  ordered 
weapon  for  allocation 


Allocate  as  many  weapons  as  possible  or  as  many  as  necessary; 
Evaluate  the  DE; 

Update  the  status  of  targets  and  weapons; 

Write  another  objective  at  this  priority  level  to  account  for  unhit  targets 


Fig.  3 — Pass  I  allocation 
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•  Ordering  all  allocatable  weapons  and  flagging  disallowed 
weapons  based  on  Pass  1  rules. 

•  Selecting  the  weapon  that  best  meets  all  requirements -- i. e. , 
the  first  allowed  weapon  in  the  ordered  list. 

•  Allocating  this  weapon  and  evaluating  the  damage  achieved.  (If 
a  target  objective  has  a  zero  DE  goal,  no  weapons  are  allocated 
and  FALCON  proceeds  to  the  next  objective.) 

Ordering  Weapons  and  Flagging  Disallowed  Weapons 

'  FALCON  orders  weapons  for  each  target  objective  by  mobility, 
timing,  alert,  damage  expectancy,  and  priority.  An  example  is  shown  in 
Fig.  4,  extracted  from  the  audit  trail. 

FALCON  first  orders  weapons  by  mobility.  For  a  mobile  target 
objective,  all  mobile-capable  weapons  are  ordered  before  any  nonmobile- 
capable  weapons,  and  vice  versa  for  a  fixed  target  objective.  The 
example  in  Fig.  4  shows  all  nonmobile-capable  weapons  (d_MMIII  through 
g_D-5H)  ordered  before  all  mobile-capable  weapons  (d_B-lBg)  for  the 
fixed  target  objective  0MT_Red. 
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Fig.  4--WS0RT:  Example  Pass  1  weapon  ordering 


22 


Next,  the  mobility-ordered  weapons  are  ordered  by  timing.  The 
following  example  shows  the  ordering  by  timing  of  weapons  based  on  the 
timing  requirement  of  the  target  objective.  This  ordering  is  designed 
to  allocate  a  weapon  that  meets,  but  least  exceeds,  the  timing 
requirement  of  the  target  objective.  If  no  weapons  meet  the  timing 
requirement  of  the  target  objective,  a  weapon  that  comes  closest  to 
meeting  it  is  allocated.  Figure  4  shows  the  mobile-capable  and 
nonmobile-capable  weapons  groups  each  sorted  by  TU,  TS,  and  NT  for  the 
TU  target  objective  0MT_Red. 


Timing  Requirement 
of  Target  Objective 

Order 

First 

Weapon  Order 
Order 
Second 

Order 

Last 

TU 

TU 

TS 

NTS 

TS 

TS 

TU 

NTS 

NTS 

NTS 

TS 

TU 

where  TU  =  Time -urgent 

T.S  =  Time-sensitive 
NTS  =  Nontime-sensitive 


Alternatively,  for  ordering  by  timing,  the  user  may  choose  to  order 
weapons  simply  by  whether  they  meet  the  timing  requirement.  In  this 
case,  weapons  that  do  meet  the  timing  requirement  are  designated  with  a 
"y"  in  the  "Time"  column;  weapons  that  do  not  meet  the  timing  requirement 
are  shown  with  an  "N". 

The  mobility-  and  timing-sorted  weapons  are  next  sorted  by  alert 
rate  if  the  scenario  is  for  generated  alert  and  the  weapons  are 
distinguished  by  alert  rate.  For  example,  the  ordering  of  weapons  in 
Fig.  4  shows  all  day-to-day  TU  weapons  (distinguished  by  a  "d_"  before 
the  weapon  name)  ordered  before  all  "g_"  (generated)  weapons  of  the  same 
type.  If  the  alert  rate  is  day-to-day  alert  or  if  weapons  are  not 
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distinguished  by  alert  rate,  no  additional  ordering  is  performed  at  this 
point . 

The  fourth  step  in  the  ordering  of  weapons  is  to  sort  the  mobility, 
timing,  and  alert-sorted  weapons  by  whether  they  meet  the  DE  goal  for 
the  target  objective;  those  that  do  meet  the  DE  goal  are  ordered  first, 
followed  by  those  that  do  not.  Note  that  in  the  example  of  Fig.  4  no 
weapons  meet  the  DE  goal  of  the  target  objective. 

Last,  the  weapons  are  ordered  either  by  DE  or  by  weapon  priority  as 
directed  by  the  user  through  an  input  rule,  AORDER.  If  ordered  by  DE, 
weapons  that  meet  or  exceed  the  DE  goal  are  ordered  from  lowest  to 
highest  DE.  This  allows  selection  of  the  weapon  that  meets  but  least 
exceeds  the  DE  goal.  Weapons  that  do  not  meet  the  DE  goal  are  ordered 
from  highest  to  lowest  DE.  This  allows  selection  of  a  weapon  that  comes 
closest  to  meeting  the  DE  goal.  Weapons  with  the  same  DE  are  further 
ordered  from  highest  priority  (lowest  priority  number  as  input  by  the 
user  in  weapons  data  input  file)  to  lowest. 

If  final  ordering  is  by  priority,  weapons  that  meet  the  DE 
requirement  for  the  target  are  ordered  from  highest  priority  to  lowest, 
regardless  of  the  individual  value  of  DE  within  that  group.  Similarly, 
weapons  that  do  not  meet  the  DE  are  ordered  from  highest  to  lowest 
priority,  regardless  of  the  individual  values  of  DE  within  that  group. 

In  the  process  of  ordering  weapons,  the  weapons  are  also  flagged  as 
either  allowed  or  disallowed  for  allocation  to  the  target  objective.  If 
the  mobility,  timing,  and/or  DE  requirements  cannot  be  relaxed,  or  if  a 
minimum  DE  has  been  required  and  has  not  been  met,  weapons  that  fail  to 
meet  these  requirements  are  not  considered  for  allocation;  i.e.,  they 
are  disallowed.  These  weapons  are  denoted  by  an  "N"  in  the  final  column 
of  Fig.  4.  All  weapons  not  disallowed  are  allowed;  these  are  denoted  by 
a  "Y"  in  the  final  column  of  Fig.  4.  Note  that  the  weapon  of  choice 
requirement  is  not  checked  at  this  time. 
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Selecting  a  Weapon 

Once  all  weapons  have  been  sorted  and  flagged  for  a  particular 
target  objective,  FALCON  selects  a  weapon  for  allocation.  Two 
possibilities  exist,  depending  on  whether  a  weapon  (or  weapons)  of 
choice  has  been  specified. 

If  the  user  has  specified  a  weapon  (or  pair  of  weapons)  as  a  weapon 
of  choice,  FALCON  checks  to  see  if  this  weapon  is  available.  If  so, 
FALCON  moves  directly  to  the  allocation  and  evaluation  portion  of  the 
program,  overriding  any  check  for  allowability  of  the  weapon.  If  the 
weapon  of  choice  specifies  a  weapon  type  or  Triad  leg,  FALCON  selects 
the  first  weapon  from  the  list  of  ordered  weapons  that  meets  the  weapon 
type  or  Triad  leg  specification.  If  the  user  specifies  a  pair  of 
weapons  by  type  or  TRIAD  leg,  the  list  of  ordered  weapons  is  checked 
twice,  once  for  each  weapon  type  or  leg  selected,  and  in  each  case 
selects  the  first  weapon  from  the  list  of  ordered  weapons  that  meets  the 
weapon  type  or  Triad  leg  specifications.  If  a  weapon  of  choice  is  not 
available,  FALCON  determines  whether  the  weapon  of  choice  requirement 
can  be  relaxed.  If  it  cannot  be,  FALCON  moves  on  to  the  next  target 
objective.  If  it  can  be,  FALCON  proceeds  as  though  no  weapon  of  choice 
were  specified. 

If  no  weapon  of  choice  is  specified,  FALCON  checks  the  list  of 
ordered  weapons  to  determine  which  weapons  are  allowed.  In  the  example 
of  Fig.  4,  since  all  requirements  are  met  or  can  be  relaxed  all  weapons 
are  allowable  for  the  target  objective.  Hence  the  final  column  contains 
all  "Ys".  falcon  selects  the  first  weapon  that  meets  all  requirements 
(the  first  weapon  with  "Y"  in  the  final  column)  as  the  weapon  to  be 
allocated. 

Allocation  and  Evaluation 

The  allocation  portion  of  FALCON  allocates  either  as  many  as 
necessary  or  as  many  as  possible  of  the  selected  weapon  to  the  current 
target  objective.  If  there  are  more  allowable  weapons  than  targets  in 
the  target  objective,  each  target  receives  one  weapon.  If  there  are 
fewer  allowable  weapons  than  targets,  one  weapon  per  target  is  allocated 
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up  to  the  number  of  allowable  weapons  available.  A  flag  is  set  to  note 
that  not  all  targets  in  the  target  objective  have  been  covered. 

Where  pairs  of  weapons  are  to  be  allocated  (weapons  of  choice  were 
pairs  of  weapons),  pairs  are  allocated  up  to  the  number  of  the  lesser 
available  member  of  the  pair.  For  example,  if  the  MMIII/B-lBg  pair  has 
been  selected  for  allocation  against  200  NUC_yellow  targets  and  there 
are  200  MMIII  but  only  175  B-lBg  weapons  available,  then  175  Mlilll  and 
all  175  B-lBg  weapons  will  be  paired  and  allocated  against  175  of  the 
NUC_Yellow  targets.  The  remaining  25  targets  must  be  covered  with  some 
other  weapon  or  pair  of  weapons,  which  may  or  may  not  include  the  25 
MMIII  left  over. 

Once  the  weapon  types  and  quantities  for  allocation  have  been 
determined,  the  damage  expectancy  of  these  weapons  against  this  set  of 
targets  is  calculated.  If  the  DE  goal  (either  an  individual  or  mean  DE 
goal)  has  not  been  met  or  if  the  user  has  required  target  coverage  for 
Pass  1  (by  requiring  the  DE  goal  be  met  as  an  individual  DE)  and  not  all 
targets  have  been  covered,  the  remaining  targets  are  rewritten  as  a 
"new"  target  objective  at  the  same  priority  level  as  the  current  target 
objective.  FALCON  returns  to  the  weapon  selection  portion  of  the 
program  to  work  on  this  new  target  objective.  For  the  above  example, 
the  new  objective  will  be  the  25  remaining  NUC.Yellow  targets.  These 
must  be  covered  or,  if  target  coverage  is  not  required,  the  DE  goal  must 
be  met  before  FALCON  can  proceed  to  allocate  weapons  to  the  next  target 
objective  (DEF_Violet  in  this  example). 

The  weapons  used  for  allocation  are  removed  from  the  allocatable 
inventory.  This  inventory  is  checked  to  ensure  that  some  weapons  remain 
before  FALCON  proceeds  to  work  on  a  new  target  objective.  When  no  more 
weapons  remain,  FALCON  prints  the  output  and  execution  terminates. 

Once  all  target  objectives  have  been  thus  evaluated,  and  if  weapons 
remain,  the  second  pass  allocation  is  initiated.  If  Pass  2  has  been 
turned  off,  FALCON  proceeds  directly  to  printout  of  the  results  and 
program  termination. 


-  26  - 


Pass  2  will  also  be  initiated  immediately  for  specified  target 
objectives  if  the  "Meet  Damage  Goal"  rule  has  been  selected.  This  rule 
says,  in  effect,  "Conduct  Pass  2  for  this  target  objective  before 
proceeding  with  Pass  1  for  the  next  lower  priority  objective." 

SECOND  PASS  ALLOCATION 

The  purpose  of  the  second  pass  allocation,  shown  in  Fig.  5,  is  to 
increase  the  achieved  DE  of  target  objectives  where  the  first  pass 
allocation  does  not  meet  the  DE  goal.  Note  that  the  DE  goal  considered 
is  that  for  the  second  pass.  Thus,  the  DE  goal  of  the  first  pass  could 
be  met,  but  additional  weapons  are  allocated  in  the  second  pass  to  meet 
its  (higher)  DE  goal. 

As  in  the  first  pass,  the  target  objectives  in  the  second  pass  are 
considered  in  priority  order.  If  (1)  the  DE  goal  of  the  objective  has 
been  met,  (2)  each  target  in  the  objective  has  received  two  weapons,  (3) 
no  weapons  meet  the  Pass  2  requirements  for  this  target  objective,  or 
(A)  Pass  2  allocations  have  already  been  made  for  this  objective  in  Pass 
1,  FALCON  proceeds  to  the  next  target  objective. 

If  none  of  these  conditions  are  met,  FALCON  determines  which  subset 
of  targets  with  fewer  than  two  weapons  per  target  has  the  lowest  weapon- 
target  DE  and  allocates  additional  weapons  first  to  this  subset.  Thus 
targets  unhit  in  the  first  pass  will  necessarily  receive  extra  weapons 
first  in  the  second  pass.  For  example,  suppose  that  the  following 
allocations  had  been  made  in  Pass  1  to  200  NUC_Yellow  targets  with  a 
Pass  2  mean  DE  goal  of  0.90: 

50  targets  were  allocated  a  .MMIII/B-lBg  weapon  pair  with  a  DE  of  0.80. 

40  targets  were  allocated  a  D-5H  with  a  DE  of  0.85. 

10  targets  were  unhit  (possibly  because  the  timing  or  DE  requirement 

could  not  be  relaxed). 

The  current  achieved  DE  for  the  allocation  would  be 


(150  X  0.80  +  40  X  0.85  +  10  x  0.0)/200  =  0.77. 
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Fig.  5 — Pass  2  allocation 
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In  the  second  pass,  FALCON  will  seek  to  allocate  weapons  to  the  subset 
of  10  targets  unhit  in  the  first  pass,  since  the  DE  of  weapons  against 
targets  in  this  allocation  subset  is  0.  If  the  DE  achieved  by  this 
allocation  against  these  ten  targets  is  still  lower  than  either  of  the 
other  two  subsets,  FALCON  will  then  attempt  to  allocate  a  second  weapon 
to  these  ten  targets.  If  not,  it  will  attempt  to  allocate  to  the  40 
targets  assigned  a  single  weapon,  since  the  other  subset  already  has  the 
maximum  allocation  of  two  weapons  per  target. 

For  mean  DE  goals,  the  rule  of  thumb  here  is  to  allocate  only  one 
additional  weapon  to  each  target  in  a  subset,  starting  with  the  subset 
with  the  lowest  weapon  per  target  damage  expectancy,  and  adding  weapons 
only  until  the  mean  DE  goal  for  the  entire  objective  is  reached.  For 
individual  DE  goals,  the  rule  of  thumb  is  to  allocate  additional 
weapons ,  so  that  each  target  is  covered  with  a  weapon  that ,  in 
conjunction  with  weapons  that  may  already  have  been  allocated,  meets  or 
exceeds  the  DE  goal. 

Weapons  are  sorted  by  mobility  for  the  second  pass,  the  same  as 
they  are  sorted  by  mobility  for  the  first  pass. 

The  ordering  of  weapons  in  Pass  2  is  similar  to  that  discussed  for 
the  Pass  1  allocation.  If  no  weapon  has  been  allocated  in  Pass  1,  the 
weapon  ordering  in  Pass  2  is  exactly  the  same  as  the  Pass  1  ordering. 
Otherwise,  weapons  are  sorted  by  (1)  mobility;  (2)  Triad  leg,  timing,  or 
neither;  (3)  alert  rate;  and  (4)  DE.  An  example  is  shown  in  Fig.  6. 

If  the  user  selects  ordering  by  timing  for  Pass  2  (the  user  input 
rule  TLSORT  =  1)  ordering  is  based  only  on  whether  the  timing 
requirement  is  met.  For  targets  already  covered  in  Pass  1,  ordering 
based  on  timing  may  be  replaced  by  ordering  based  on  Triad  hedging 
(TLSORT  =3).  In  this  case,  weapons  from  a  Triad  leg  different  from 
that  of  the  weapon  allocated  in  Pass  1  are  ordered  first,  followed  by 
weapons  from  the  same  leg  as  the  Pass  1  allocation,  and  last,  the  same 
weapon.  If  sorting  by  timing  or  Triad  leg  is  bypassed  (TLSORT  =  2), 
weapons  will  remain  in  their  ordering  by  mobility. 
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Fig.  6--WSORT2:  Example  Pass  2  weapon  ordering 

In  ordering  by  weapon  alert  status  in  Pass  2,  FALCON  uses  two 
ordering  schemes:  (1)  if  the  weapon  allocated  in  Pass  1  was  available 
on  day-to-day  alert  (or  if  no  distinction  is  made  between  day-to-day  and 
generated  weapons),  no  additional  ordering  is  performed  by  alert  rate 
(this  is  designated  by  an  "A"  for  "All"  in  the  "Alert"  column  of  Fig. 

6);  (2)  if  the  weapon  allocated  in  Pass  1  was  a  generated  weapon  and 
weapons  are  distinguished  as  day-to-day  or  generated,  day-to-day  alert 
weapons  will  be  ordered  first,  followed  by  generated  weapons. 

In  Pass  2,  ordering  by  whether  the  DE  goal  is  met  is  independent  of 
the  specification  of  the  DE  goal  as  a  mean  DE  goal  for  the  target 
objective  as  a  whole  or  an  individual  DE  goal  to  be  met  by  each  target 
in  the  target  objective.  Ordering  will  be  first  by  weapons  (in 
conjunction  with  the  weapon  allocated  in  Pass  1)  that  meet  the  DE  goal 
(taken  as  an  individual  target  DE  goal)  and  next  by  weapons  that  do  not. 
The  difference  between  the  specification  of  mean  or  individual  DE  goal 
will  arise  in  the  number  of  weapons  allocated.  For  a  mean  DE  goal, 
FALCON  will  allocate  only  as  many  weapons  as  are  needed  to  bring  the  DE 
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for  the  total  target  objective  to  the  required  DE  goal.  For  an 
individual  DE  goal,  FALCON  will  allocate  (if  possible)  additional 
weapons  to  each  target  so  that  each  target  meets  the  DE  goal. 

In  addition  to  the  rules  for  flagging  disallowed  weapons  in  Pass  1 
(if  weapons  are  sorted  by  Triad  leg  rather  than  by  timing),  Pass  2 
provides  for  disallowing  weapons  from  the  same  Triad  leg  or  disallowing 
the  same  weapon  as  allocated  in  Pass  1.  As  in  Pass  1,  FALCON  selects 
the  first  allowed  weapon  in  the  ordered  list  for  allocation.  An  example 
of  Pass  2  weapon  ordering  and  flagging  is  shown  in  Fig.  6. 

Pass  2  concludes  when  all  weapons  have  been  depleted,  all  goals 
have  been  reached,  all  target  objectives  have  received  two  weapons  per 
target,  or  no  remaining  allocatable  weapons  are  allowed  for  unmet 
objectives . 

OUTPUT 

Output  for  FALCON  consists  of  two  output  text  files  (the  results 
file  and  the  audit  trail)  detailing  the  allocation.  The  results  file 
contains  weapon-to-target  allocation  for  both  passes  and  resultant 
damage  expectancies.  The  tables  included  in  this  file  are: 

•  Echoes  of  the  input  data. 

•  Inventory  of  weapons  by  weapon  status. 

•  Weapon-target  damage-expectancy  matrix. 

•  Allocation  of  weapons  by  target  objective. 

•  Allocation  of  weapons  by  weapon  type. 

•  Summary  allocation  of  weapons  by  weapon  type. 

•  Damage  summary  by  target  objective  (and  scenario,  if  so 
selected) . 

•  Damage  summary  by  target  group  and  target  mobility. 

•  Damage  by  weapon  timing  (and  scenario,  if  so  selected). 

•  Damage  summary  by  weapon  timing  (and  scenario,  if  so  selected). 
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In  three  of  the  tables,  as  indicated  above,  results  will  be  printed 
for  the  following  four  scenarios  if  the  user  has  so  selected: 

•  Day-to-day  alert,  delayed  response. 

•  Day-to-day  alert,  prompt  launch. 

•  Generated  alert,  delayed  response. 

•  Generated  alert,  prompt  launch. 

If  results  for  additional  scenarios  are  to  be  printed,  the  allocation 
based  on  the  user's  selection  of  alert  rate  and  launch  strategy  (e.g., 
generated  alert,  launch-under-attack)  is  not  changed.  Rather,  the 
allocation  remains  fixed  and  the  damage  expectancies  are  recalculated  to 
account  for  the  different  scenario  planning  factors. 

These  new  DE  calculations  must  account  for  the  FTP  and  PLS  factors 
appropriate  for  each  scenario: 

DEg  =  DE^  (PLSg  *  PTPg)/(PLS^  *  PTP^) 

where  DEg  =  the  DE  for  the  new  scenario 

DE.  =  the  DE  for  the  current  allocation  scenario 
A 

PLSg  =  the  PLS  for  the  new  scenario 

PTPg  =  the  PTP  for  the  new  scenario 

PLS.  =  the  PLS  for  the  current  allocation  scenario 
A 

PTP,  =  the  PTP  for  the  current  allocation  scenario. 

A 

For  pairs  of  weapons,  the  weapon  per  target  DE  for  each  member  of  the 
pair  is  so  modified  before  these  values  are  combined  to  obtain  the  joint 
DE.  For  all  scenarios,  if  the  PLS  has  been  accounted  for  by  a  decrease 
in  the  number  of  allocatable  weapons  (the  rule  IPLS  is  set  to  "l"),  the 
PLS  factor  in  the  above  equations  is  set  to  1.0. 

The  numbers  of  weapons  allocated  to  each  target  objective  in  the 
"new"  scenarios  will  remain  unchanged  unless  the  original  allocation 
scenario  was  for  generated  alert,  weapons  were  distinguished  as 
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generated  and  day  to  day,  and  the  case  now  being  calculated  is  a  day- 
to-day  scenario.  In  this  case,  only  day-to-day  weapons  will  be 
considered  in  the  new  scenario. 

A  complete  example  of  the  results  file  is  shown  in  Figs.  11a 
through  llq  of  Sec.  IV. 

The  audit  trail  prints  information  from  each  step  in  the  allocation 
process.  The  length  of  this  file  will  depend  on  the  degree  of 
diagnostic  output  the  user  "has  selected.  A  complete  example  of  this 
file  is  shown  in  App.  D. 
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IV.  RUNNING  FALCON 


To  execute  FALCON,  the  user  follows  these  steps: 

1.  On  a  text  editor  or  word  processor,  enter  the  weapons  data  into 
an  input  text  file.  An  example  of  this  file  is  shown  in  Fig. 

7.  A  description  of  the  weapons  data  is  contained  in  this 
figure  for  clarity  but  is  not  necessary  for  program  execution. 

2.  Enter  the  rules  and  target  objectives  data  into  an  input  text 
file.  An  example  of  this  file  is  shown  in  Fig.  8.  Again,  a 
description  of  the  data  is  contained  in  this  figure  but  is  not 
necessary  for  program  execution. 

3.  If  any  SSPK  values  are  to  be  entered  by  the  user,  enter  these 
data  into  an  input  text  file.  Care  should  be  exercised  to 
ensure  that  the  spelling  of  the  weapon  and  target  names  in  this 
file  exactly  match  that  in  the  weapons  and  targets  files.  An 
example  of  the  SSPK  data  file  is  shown  in  Fig.  9.  If  SSPK 
values  are  to  be  determined  solely  by  formula  or  solely  by 
PDCLC4,  this  step  should  be  skipped. 

4.  Type  "FALCON"  at  the  keyboard.  Execution  is  initiated.  Follow 
the  prompts  for  the  input  and  output  file  names  and  run  name. 
Messages  tracking  execution  progress  are  printed  to  the  screen 
as  shown  in  Fig.  10. 

5.  Review  the  two  FALCON  output  files; 

•  The  results  file,  which  shows  the  allocation  of  weapons  to 
targets  and  resultant  damage  expectancies.  An  example  of 
this  file  is  shown  in  Figs.  11a  through  llq. 

•  The  audit  trail,  which  shows  the  sequence  of  steps  and  the 
application  of  rules  in  deriving  the  allocations  shown  in 
the  results  file.  An  example  of  this  file  is  shown  in  App. 
D. 


Various  conditions  that  might  arise  during  program  execution  will 
cause  FALCON  to  stop:  (1)  the  calculated  DE  is  zero  or  (2)  the  total 
number  of  distinct  allocations  to  all  targets  exceeds  three  times  the 
number  of  target  objectives.  When  these  errors  occur,  execution  is 
halted  and  explanatory  messages  are  printed  on  the  screen  and  in  the 
audit  trail.  Should  the  first  error  occur,  the  user  may  (1)  check  to 
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ensure  proper  inputs,  and  (2)  enter  a  nonzero  SSPK  in  the  optional  SSPK 
data  file.  If  the  second  error  occurs,  the  user  should  increase  the 
size  of  the  allocation  arrays  as  described  in  App.  E.  Other  execution 
errors  should  be  brought  to  the  attention  of  the  authors. 
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Fig.  7 — WEAPS.DAT — the  weapons  data  file 
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Fig.  9 — SSPK.DAT — SSPK  data  file 
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C:\fALCON>falcon 
BEGIN  FALCON  2.0 

Enter  the  name  of  the  output  file  for  Results: 

(max  8  characters  plus  3-character  extent) 
result. out 

Enter  the  name  of  the  output  file  for  Diagnostics: 

(max  8  characters  plus  3-character  extent) 
audit . out 

Enter  the  name  of  the  Target  Data  Input  File: 

(max  8  characters  plus  3-character  extent) 
targs.dat 

Enter  the  name  of  the  Weapons  Data  Input  File: 

(max  8  characters  plus  3-character  extent) 
weaps.dat 

Enter  the  run  name  (max  80  characters) 

Example  Run 

CALCULATING  WEAPON  INVENTORIES 

CALCULATING  SSPK  VALUES 

Enter  the  name  of  SSPK  Data  Input  File: 

(max  8  characters  plus  3-character  extent) 
sspk.dat 

BEGIN  PASS  1  EVALUATION 
BEGIN  WORKING  ON  TARGET  OBJECTIVE  OMT.Red 
BEGIN  WORKING  ON  TARGET  OBJECTIVE  LDR_Blue 
BEGIN  WORKING  ON  TARGET  OBJECTIVE  NUC.Orange 
BEGIN  WORKING  ON  TARGET  OBJECTIVE  NUC_Yellow 
BEGIN  WORKING  ON  TARGET  OBJECTIVE  DEF_Violet 
BEGIN  PASS  2  EVALUATION 

Working  on  target  objective:  OMT_Red  of  priority  1 

Working  on  target  objective:  OMT_Red  of  priority  ] 

Working  on  target  objective:  NUC_Yellow  of  priority  4 

Working  on  target  objective:  NUC_Yellow  of  priority  4 

Working  on  target  objective:  NUC_Yellow  of  priority  4 

END  FALCON 

Stop  -  Program  terminated 


Fig.  10 — FALCON  execution — example  screen  display 


TARGET  OBJECTIVES  AND  RULES  DATA: 
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Fig.  11a — RESULT. OUT — the  input  objectives 
and  rules  are  echoed 
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Fig.  11c — RESULT. OUT — Inventory  of  weapons  by  weapon  status 
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Appendix  A 

SUBROUTINE  DESCRIPTIONS 


This  appendix  contains  the  calling  sequence  for  FALCON,  shown  in 
Fig  A.l,  followed  by  brief  descriptions  of  each  subroutine. 

FALCON  uses  three  subroutines  in  the  public  domain.  PDCLC4,  which 
calculates  the  SSPK  for  each  weapon/target  pair,  and  ERRMS4,^  which 
prints  PDCLC4  error  messages,  were  provided  by  Headquarters,  Strategic 
Air  Command,  Omaha,  Nebraska.  PDEXEC,  which  determines  the  optimum 
weapon  height  of  burst  and  prepares  the  call  to  PDCLC4,  was  provided  by 
The  Stonehouse  Group,  Denver,  Colorado. 


SUBROUTINE  DESCRIPTIONS 

ABUMP  (II)  bumps  (or  shifts)  values  in  the  ALLOC  arrays  to  allow  room  for 
additional  array  entries.  A  zeroed  element  is  added  after  the 
II  element  and  all  subsequent  elements  are  bumped  up  by  1. 

DNCALC  calculates  the  total  DE  for  the  current  objective  after  the 

reallocation  of  weapons  to  targets. 

ERRMS4  ( I ERR . I V , JT , KF . YLD , CEP , HOB  1 , R95 , D , WR , POD , I FLG , AZMTH , LU ) 

prints  error  messages  for  the  subroutines  PDCLC4  and  PDCALC. 
See  the  source  code  for  PDCLC4  for  a  description  of  the  passed 
variables . 

EVALDE  evaluates  the  damage  due  to  the  current  allocation  of 

weapons  against  the  current  target  objective,  updates  the 
weapon  inventories,  and  condenses  the  list  of  available 
weapons,  where  necessary. 

FALCON  is  the  main  program  of  the  strategic  iorce  allocation  model. 

It  governs  all  program  operations  through  reading  of  input 
data,  initialization,  calculation  of  weapon  inventories, 
determination  of  suitable  weapons  for  allocation,  allocation 
of  weapons,  and  evaluation  of  damage. 

OBPRIO  establish  priorit.  s  for  the  objectives.  The  results  are  the 

values  NIP,  the  highest  priority  of  any  objectives,  and 

'ERR.MS4  as  supplied  by  Headquarters,  Strategic  Air  Command,  is  a 

subroutine  called  by  PDCLC4.  We  have  extracted  it  in  this  document 

because  we  also  call  it  from  PDCALC. 
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PROGRAM  FALCON 


CALLS; 

WHICH 

WHICH 

WHICH 

WHICH 

WHICH 

CALLS : 

CALLS : 

CALLS: 

CALLS: 

CALLS 

READID. . , 

,  . .READOD. . .  . 

. . . .SETDEF 

READWD 

OBPRIO 

writ'od 

WINVNT... 

, . .WINVO 

SSPKT. . . , 

,  . .PDCALC. . . . 

. . . .PDEXEC*.. . , 

,  ...PDCLC4*... 

. . . .ERRMS4 

PDCLC4 . 

ERRMS4 

, . . .ERRMS4 

WRSSPK. . . . 

. . . .WRHOB 

WCOUNT 

WSORT. . . , 

, . .WSORTM 
WSORTT. . . . 

. . . .WSRTT2 

WSORTA 

WSORTD 

WSPRDE 

WSORTP 

REQMOB 

REQTIM 

REQDE 

REQWOC . SWOC 

WSELCT 

WALLOC 

EVALDE . SCNDEl 

SCNDE2 


RCASTl 


* 

Subroutines  called  solely  by  PDEXEC  or  PDCLC4  are  not  shown  in  this 
figure. 


Fig.  A. 1--Structure  of  calling  sequence 
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RCAST2 


RPOUT 


REINIT. .  _ ABUMP 

WSORT2 . WSORTM 

WSORTT 

WSRTT2 

WSORTL 

WSORTA 

WSRTA2 

WSORTD 

WSRTD2 

WSPRDE 

WSPDE2 

WSORTP 

REQMOB 

REQTIM 

REQLEG 

REQDE 

REQDE2 

WSELCT 

WALLC2 . WNCALC 


WUNHIT. . . . 

. . . .SCNDE2 

ABUMP 

DNCALC 

SCNDE2 

ABUMP 

DNCALC 

SCNDEl 

WCOUNT 

RPOUTl . . . . 

. . . .SCNDE3 

RPOUT2. . . . 

. . ..R0UT20 
ROUT21. . . . 

- ROUT2A. . . . 

. . . .ROUT23 
SCNDE3 

ROUT23 . . . . 
SCNDE3 

. .  . .  SCNDE3 

ROUT22. . . . 

_ ROUT2B _ 

SCNDE3 

. . . . SCNDE3 

RPOUT3. . .  . 

. . . .R0UT30 

UOUT . 

....SCNDE3 

RP0UT4 .... 

. . . .R0UT40 

UOUT . 

.  . . . SCNDE3 

SCNDE3 


Fig .  A . 1 - -cont inued 
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IPRIO,  the  array  of  objectives  in  priority  order,  both 
stored  in  /PRIO/.- 

PDCALC  sets  up  the  calls  to  PDCLC4  for  each  weapon  in  combination 

with  each  target  objective. 

PDCLC4  (IV,JT,KF,YLD,HOBl,R95,CEP,D,WR,POD,IFLG,IERR,AZMTH) 

calculates  the  single-shot  probability  of  kill.  See  the 
source  code  for  a  description  of  the  passed  variables. 

PDEXEC  ( I V , JT , KFACT , YLD , HOB  I , R95NM , CEP , OFFNM , WR , P , IFLGC , lERR , AZMTH) 

determines  the  optimum  HOB.  See  the  source  code  for  PDEXEC 
and  PDCLC4  for  a  description  of  the  passed  variables. 

RCASTl  (IRCAST) 

recasts  or  rewrites  the  current  objective,  if  necessary,  and 
regenerates  the  list  of  allowable  weapons  to  be  applied  to 
it.  An  objective  is  recast  ONLY  if: 

1)  there  are  untargeted  targets  (that  is  what  set 
IRCAST  to  nonzero  in  the  first  place),  AND 

2)  there  are  more  allocatable  weapons. 
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RCAST2(IMDR) 


READ ID 
READOD 

READWD 

REINIT 

REQDE 


does  the  second  pass  of  FALCON.  IMDR  is  an  input  flagging 
whether  Pass  2  weapons  are  being  allocated  globally  (IMDR  =  0) 
or  whether  Pass  2  allocations  are  being  determined  as  part 
of  Pass  1  for  a  single  objective  (IMDR  =  K,  where  K  is  the 
index  of  the  objective  requiring  additional  weapons  be 
allocated  to  meet  the  DF.  objective  before  going  to  a  lower 
priority  objective,  i.e.,  MDR(K')  =  .  por  IMDR=0,  RCAST2 

goes  through  each  of  the  objectives  in  priority  order.  If 
the  objective  has  been  met  or  each  target  in  the  objective 
has  been  covered  with  2  weapons  per  target  (WPT) ,  RCAST2 
moves  on.  If  the  objective  has  not  been  met,  and  the  2  WPT 
limit  has  not  been  exceeded,  RCAST2  determines  which  subset 
of  weaponr  requires  the  higher  DE,  the  exact  value  of  the  DE 
required,  and  then  allocates  remaining  weapons  appropriately. 
For  IMDR  =  K  (not  equal  to  0)  the  above  procedure  is  followed 
using  all  Pass  2  logic,  but  allocations  are  found  for  the 
single  objective. 

is  the  governing  subroutine  for  reading  input  data. 

reads  in  all  input  objectives,  rules  and  other 

setup  information  and  stores  these  in  OBJ,  RULES,  TARGT, 

and  PRINT  common  blocks. 

reads  and  stores  the  input  weapons  and  defenses  data. 

initial ixes  the  ALLOC  arrays  for  the  second  pass. 

checks  the  DE  REQuirement  of  weapons  against  the 
current  objective.  The  flag  ICONT  is  set  according  to  the 
following  outcomes: 

ICONT  =  0  -  No  weapon  was  found  that  meets  the 
DE  requirement. 

ICONT  =  1  -  No  weapon  was  found  that  meets  the  DE 

requirement,  but  this  requirement  can  be 
relaxed.  Continue  with  weapon  selection. 
ICONT  =  2  -  A  weapon  was  found  that  meets  the  DE 
requirement;  continue  with  weapon 
selection. 
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REQDE2(IDL0W) 

checks  the  DE  REQuirement  of  weapons  in  Pass  2  against  the 
current  objective.  IDLOW  is  the  index  of  the  current  weapon 
allocation.  The  flag  ICON!  is  set  according  to  the 
following  outcomes: 

ICONT  =  0  -  No  weapon  was  found  that  meets  the  DE 
requirement . 

ICONT  =  1  -  No  weapon  was  found  that  meets  the  DE 

requirement,  but  this  requirement  can  be 
relaxed.  Continue  with  weapon  selection. 

ICONT  =  2  -  A  weapon  was  found  that  meets  the  DE 
requirement;  continue  with  weapon 
selection. 

REQLEGC IDLOW) 

checks  the  LEG  REQuirement  of  weapons  against  the  current 
objective.  IDLOW  is  the  index  of  the  current  weapon 
allocation.  The  flag  ICONT  is  set  according  to  the 
following  outcomes: 

ICONT  =  0  -  No  weapon  was  found  that  meets  the 
leg  requirement. 

ICONT  =  1  -  No  weapon  was  found  that  meets  the  leg 

requirement,  but  this  requirement  can  be 
relaxed.  Continuing  with  selection  of 
weapon. 

ICONT  =  2  -  A  weapon  was  found  that  meets  the  leg 
requirement;  continue  with  weapon 
selection. 

REQMOB  checks  the  MOBility  REQuirement  of  weapons  against  current 

objective.  The  flag  ICONT  is  set  according  to  the 
following  outcomes: 

ICONT  =  0  -  No  weapon  was  found  that  meets  the 
mobility  requirement. 

ICONT  =  1  -  No  weapon  was  found  that  meets  the 

mobility  requirement  but  this  requirement 
can  be  relaxed.  Continuing  with  weapon 
selection . 

ICONT  =  2  -  A  weapon  was  found  that  meets  the 

mobility  requirement;  continue  with 
weapon  selection. 
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REQTIM 


REQWOC 


ROUT2A(LU) 

ROUT2B(LU) 

R0UT20(LU) 

ROUT21(LU) 

ROUT22(LU) 

ROUT23 


checks  the  TIMing  REQuirement  of  weapons  against  the 
current  objective.  The  flag  ICONT  is  set  accordin''  to  the 
following  outcomes: 

ICONT  =  0  -  No  weapon  was  found  that  meets  the 
timing  requirement. 

ICONT  =  1  -  No  weapon  was  found  that  meets  the 

timing  requirement  but  this  requirement 
can  be  relaxed.  Continuing  with 
selection  of  weapon. 

ICONT  =  2  -  A  weapon  was  found  that  meets  the  timing 
requirement;  continue  with  weapon 
selection. 

check  the  REQuirement  for  a  WQC  for  the  current  objective. 

If  the  weapon  (or  weapons)  specified  are  available,  these 
are  stored  in  lUSE(l)  and,  if  appropriate,  IUSE(2).  The 
flag  ICONT  (in  AWEAPS  common)  is  set  according  to  the 
following  outcomes: 

ICONT  =  0  -  Nc  woe  available  and  WOC  rule  can 
not  be  relaxed. 

ICONT  =  1  -  No  weapons  of  choice  available  but 

weapon  of  choice  rule  can  be  relaxed 
OR  no  weapon  of  choice  selected--return 
for  default  weapon  selection. 

ICONT  -  2  -  WOC  found;  continue  to  allocation, 

displays  the  goals  achieved  versus  the  desired  objectives 
in  summary  format  for  the  allocation  scenario  only. 

LU  is  the  logical  unit  to  which  output  is  sent. 

continues  the  allocation  display,  writing  the  summary  tables 
for  the  allocation  scenario  only.  LU  is  the  logical  unit  to 
which  output  is  sent. 

displays  the  summary  allocation  of  weapons  used  against 
targets  by  weapon  type  and  Triad  leg.  LU  is  the  logical  unit 
to  which  output  is  sent. 

displays  the  goals  achieved  vs  the  desired  objectives  in 
summary  format.  LU  is  the  logical  unit  to  which  output  is 
sent . 

continues  the  allocation  display,  writing  the  summary 
tables.  LU  is  the  logical  unit  to  which  output  is  sent. 

displays  the  goals  achieved  vs  the  desired  objectives  for  all 
scenarios . 
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R0UT30(LU,I50) 

displays  the  time-ordered  allocation  table  headers. 

LU  is  the  logical  unit  to  which  output  is  sent.  150  is 
an  index  for  the  scenario  to  be  displayed. 

ROUT40(LU,150) 

displays  the  time-ordered  allocation  table  headers  by  fixed, 
mobile  and  total.  LU  is  the  logical  unit  to  which  output  is 
sent.  150  is  an  index  for  the  scenario  to  be  displayed. 

RPOUT  manages  the  printout  of  all  results. 

RPOUTl(LU)  displays  the  goals  achieved  vs  the  desired  objectives.  LU 
is  the  logical  unit  to  which  output  is  sent. 

RP0UT2(LU)  displays  the  allocation  of  weapons  used  against  targets. 

LU  is  the  logical  unit  to  which  output  is  sent. 

RP0UT3(LU)  displays  the  time-ordered  allocation.  LU  is  the  logical 
unit  to  which  the  output  is  sent. 

RP0UT4(LU)  displays  the  time-ordered  allocation  by  target  groups. 

LU  is  the  logical  unit  to  which  the  ouput  is  sent. 

SCNDEKIl.SCDE.IW) 

calculates  the  scenario  DE  for  a  single  weapon  against  a 
target,  where: 

II  -  the  index  of  the  DEA  array 
SCDE  -  the  current  DE  (the  DE  for  the  allocation 
scenario) 

IW  -  the  index  of  the  weapon  being  evaluated  in  the 
current  scenario 
Results  are  stored  in  DEA(Il,i) 
where  i  =  1,4  for  each  of  the  four  scenarios. 

SCNDE2(I1,SCDE1,IW1,SCDE2,IW2) 

calculates  the  scenario  DE  for  a  pair  of  weapons 
against  a  target,  where: 

II  -  the  index  of  the  DEA  array 
SCDEl  -  the  current  DE  (the  DE  for  the  allocation 
scenario)  of  the  first  weapon  in  the  pair 
IWl  -  the  index  of  the  first  weapon  being  evaluated 
in  the  current  scenario 
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SCDE2  -  the  current  DE  (the  DE  for  the  allocation 
scenario)  of  the  second  weapon  in  the  pair 
IW2  -  the  index  of  the  second  weapon  being  evaluated 
in  the  current  scenario 
Results  are  stored  in  DEA(Il,i) 
where  i  =  1,4  for  each  of  the  four  scenarios. 

SCNDE3(IW,ISX,SDE) 

calculates  the  scenario  DE  for  a  single  weapon  against  a 
target,  where: 

IW  -  the  index  of  the  weapon  to  be  evaluated 
ISX  -  the  index  of  the  scenario  to  be  evaluated 
SDE  -  the  scenario  DE  (an  output  variable) 

SETDEF  sets  the  default  values  for  the  rules. 

SSPKT  operates  on  the  SSPK  data--input  by  the  user,  calculated 

by  PDCALC  or  determined  by  the  equation--to  create  a  DE 
table  (really  a  weapon-target-vulnerability  table).  All 
DE  values  are  checked--if  a  zero  DE  is  found,  FALCON 
execution  terminates. 

SWOC(INDEX,INDXI) 

selects  the  weapon(s)  of  choice  for  a  given  WOC  selection, 
W0C(IC0, INDEX) ,  where  WOC  and  ICO  are  read  from  labelled 
common,  and  INDEX,  either  1  or  2,  is  an  input  parameter 
indicating  whether  the  first  or  second  weapon  of  choice  is 
being  used.  INDXI ,  either  1  or  2,  is  an  input  parameter 
telling  whether  one  or  two  weapons  are  selected  as  the 
woapon(s)  of  choice. 

UOUTdSO ,  INT.NUMSW,  INDEX.WDEC) 

is  a  utility  routine  to  help  make  calculations  of  output 
parameters  more  efficient.  It  performs  calculations  across 
passes  for  weapons  and  pairs. 

150  is  an  index  for  the  scenario  currently  being 
calculated 

where  150  =  1  is  for  day-to-day,  ride-out-attack 

=  2  is  for  day-to-day,  launch-under-attack 
=  3  is  for  generated,  ride-out-attack 
=  4  is  for  generated,  launch-under-attack 
INT  is  the  number  of  weapons  for  an  objective  that  does 
not  meet  the  time-urgency  requirements 
NU.MSW  is  the  number  of  targets  covered,  by  time  urgency 
INDEX  is  an  array  of  the  numbers  of  weapon  types 
allocated  by  time  urgency 

WDEC  is  the  array  of  total  DEs  achieved  as  a  result  of 
weapon  allocation  (by  scenario) 


WALLC2(IDL0W,IG00N) 

does  the  second  pass  weapon  allocation.  IDLOW  is  the  index 
of  the  target  subset  that  requires  further  allocation. 

IGOON  says  to  go  on  to  the  next  objective  (IG00N=1)  when 
there  are  no  suitable  weapons  left  or  when  the  DE  goal  has 
been  met. 

WALLOC(IRCAST) 

allocates  as  much  as  possible  or  as  many  as  necessary  of  a 
selected  weapon.  If  there  are  not  enough  of  the  weapon  to 
meet  the  objective,  IRCAST  is  set  to  "l". 

WCOUNT(NWEAP) 

counts  the  number  of  available  weapons,  NWEAP,  and 
reconstructs  the  list  of  allowable  weapons,  taking  out 
anywhere  the  inventory  is  zero. 

WINVNT  calculates  the  inventories  of  weapons.  This  accounts  for 

losses  and  alert  rates. 

WINVO  displays  the  inventory  of  weapons  and  accounts  for  losses 

due  to  availability,  withold,  and  other  factors. 

WNCALC(Il,IW,NkTEST) 

calculates  the  total  number  of  weapons  needed  to  just  meet 
the  DE  requirement.  II  is  the  index  for  the  current 
allocation,  IW  is  the  idex  for  the  current  weapon,  and  NWTEST 
is  the  calculated  number  of  weapons  to  be  used. 

WRHOB(LU,HOBW) 

writes  the  HOB  values  (HOBW)  of  weapons  by  targets  to  the 
logical  unit  (LU)  specified. 

WRITOD(LU)  writes  all  rules  to  AUDIT. OUT.  LU  is  the  logical  unit  to 
which  the  output  is  sent. 

WRSSPK(LU)  writes  the  SSPK/DE  values  of  weapons  by  targets  to  the 

logical  unit  (LU)  specified.  If  weapons  are  distinguished  by 
alert  rate,  the  SSPK  values  for  the  weapon  group  only  are 
printed . 

WSELCT  selects  the  single  weapon  to  be  allocated  that  meets  as 

many  of  the  requirements  as  possible.  The  flag  ICONT  is 
set  according  to  the  following  outcomes: 
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WSORT 


WSORTA 


WSORTD 


ICONT  =  0  -  No  weapons  were  found  that  meet  the 
requirements . 

ICONT  =  1  -  A  weapon  was  found  that  meets  the 
requirements  (some  may  have  been 
relaxed);  continue  with  weapon  selection. 

sorts  all  available  weapons  by: 

Mobility  -  For  mobile  targets,  mobile  capable  weapons 
are  sorted  before  nonmobile  ones;  for 
nonmobile  targets,  the  reverse  is  true. 

Time  Urgency  -  For  TU  targets  weapons  are  sorted  as 
time-urgent,  time-sensitive,  nontime- 
sensitive;  for  time-sensitive  targets 
weapons  are  sorted  as  time-sensitive, 
time-urgent  and  nontime-sensitive;  and 
for  nontime-sensitive  targets,  weapons 
are  sorted  as  nontime-sensitive,  time- 
sensitive,  and  time-urgent. 

Alert  rate  -  If  weapons  are  distinquished  as  day  or 

generated,  day  weapons  are  ordered  first. 

If  no  distinction  is  made,  no  unique 
ordering  by  alert  rate  is  made. 

DE  Requirement  -  Weapons  that  meet  the  current  target 
objective  DE  are  ordered  before  those 
that  do  not. 

Priority  -  Weapons  are  finally  sorted  by  priority. 

A  sorts  the  available  weapons  by  alert  rate.  If  no 
distinction  is  made  between  generated  and  day-to-day 
weapons,  IDXSA  remains  unchanged  and  an  "A"  (for  ALL)  is 
placed  in  the  appropriate  cell  of  AWT.  If  weapons  are 
differentiated  by  alert  rate,  day-to-day  weapons  are 
ordered  first  and  generated  weapons  second. 

sorts  the  available  weapons  by  DE.  Weapons  that  do  meet 
the  DE  requirement  for  the  objective  are  ordered  first  and 
a  "Y"  (for  YbS,  "hey  do  meet  the  requirement)  is  placed 
into  the  appropriate  cell  of  AWT).  Weapons  that  do  not 
meet  the  requirement  are  ordered  second  and  an  "N"  (for 
NO,  does  not  meet  the  requirement)  is  placed  in  the 
appropriate  cell  of  AWT.  Note:  If  a  weapon  DE  is  less  than 
the  minimum  DE  required  for  allocation,  an  "N"  is  placed  in 
AWT  and  that  weapon  is  not  allowed  for  allocation. 
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WSORTL(IDLOW) 

sorts  the  available  weapons  by  weapon  leg.  Weapons  of 
different  legs  from  those  allocated  in  the  first  pass  are 
sorted  first,  then  weapons  of  the  same  leg,  different 
weapons,  then  the  same  weapon.  This  sorting  also  accounts 
for  prompt  launch  dependency.  (This  subroutine  uses  the 
same  arrays  as  those  used  by  WSORTT.)  IDLOW  is  an  index  for 
the  current  allocation. 

WSORTM  sorts  the  available  weapons  by  mobility.-  For  mobile 

targets  mobile  capable  weapons  are  sorted  before  nonmobile 
ones;  for  nonmobile  targets,  the  reverse  is  true. 

WSORTP  prioritizes  the  available  weapons  by  input  priority  order. 

Specifically,  for  each  group  of  weapons  that  do  meet  the 
DR  requirement,  these  weapons  arc  ordered  from  highest  to 
lowest  input  priority  order,  and  similarly  for  weapons 
that  do  not  meet  the  DE. 


WSORTr(IP)  sorts  the  available  weapons  by  time  urgency.  For  TU 

targets  weapons  arc  sorted  as  time-urgent,  time-sensitive, 
nontime-sensitive;  for  time-sensitive  targets  weapons  are 
sorted  as  time-sensitive,  time-urgent,  and  nontime- 
sonsitive;  and  for  nontime-sensitive  targets,  weapons  are 
sorted  as  nontime-sensitive,  time-sensitive,  and  time- 
urgent.  IP  tells  which  pass  is  active  (1  or  2). 


WS0RT2(IDh0W,DEREQ) 

sorts  all  available  weapons  for  the  Pass  2  allocations. 
IDLOW  is  the  index  of  the  current  objective.  DEREQ  is  the 
weapon-por-target  DE  required  to  meet  the  goal  DE. 


WSPDE2( IDLOW) 

prioritizes  tlie  available  weapons  by  DE  for  Pass  2. 
Specifically,  for  each  group  of  weapon  (pairs)  that  do 
meet  the  DE  requirement,  iliese  weapons  are  ordered  from 
lowest  to  higliest  DE,  so  a  weapon  that  meets  but  least 
exceeds  the  DE  is  selected.  For  weapons  that  do  not  meet 
the  DE ,  these  are  ordered  from  highest  to  lowest  DE  so  a 
weapon  that  comes  closest  to  meeting  the  DE  will  be  chosen 
(if  no  weapons  meeting  the  DE  can  bo  chosen).  IDLOW  is  the 
index  of  the  current  allocation. 
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WSPRDE  prioritizes  the  available  weapons  by  DE.  Specifically,  for 

each  group  of  weapons  that  do  meet  the  DE  requirement, 
these  weapons  are  ordered  from  lowest  to  highest  DE,  so 
a  weapon  that  meets  but  least  exceeds  the  DE  is  selected. 
For  weapons  that  do  not  meet  the  DE,  these  are  ordered  from 
highest  to  lowest  DE,  so  a  weapon  that  comes  closest  to 
meeting  the  DE  will  be  chosen  (if  no  weapons  meeting  the  DE 
can  be  chosen). 


WSRTA2(IDL0W) 

sorts  the  available  weapons  by  alert  rate  for  Pass  2.  If 
no  distinction  is  made  between  generated  and  day-to-day 
weapons,  or  if  alert  distinction  is  made  and  a  day-to-day 
weapon  was  allocated  in  Pass  1,  IDXSA  remains  unchanged  and 
an  "a"  (for  ALL)  is  placed  in  the  appropriate  cell  of  AWT. 

If  weapons  are  differentiated  by  alert  rate,  and  a 
generated  weapon  has  been  allocated  in  Pass  1,  day-to-day 
weapons  arc  ordered  first.  IDLOW  is  the  index  of  the  current 
al location. 

WSRTD2(IDL0W,DEREQ) 

sorts  the  available  weapons  for  Pass  2  by  DE.  Weapons  that 
meet  the  DE  requirement  for  Pass  2  when  paired  with  weapons 
already  allocated  in  Pass  1  are  ordered  first  and  a  "Y" 

(for  YES,  tliey  do  meet  the  requirement)  is  placed  into  the 
appropriate  cell  of  AWT).  Weapons  that  do  not  meet  the 
requirement  arc  ordered  second  and  an  "N"  (for  NO,  does  not 
meet  the  requirement)  is  placed  in  the  appropriate  cell  of 
AWT.  An  "N"  is  also  placed  in  this  array  if  the  weapon  does 
not  meet  the  minimum  weapon-per-target  DE,  if  specified. 

IDLOW  is  the  index  of  the  current  allocation.  DEREQ  is  the 
weapon-per-target  DE  value  required  to  meet  the  DE  goal. 

WSRTr2  sons  the  available  weapons  by  time  urgency.  Weapons  are 

sorted  into  two  groups  only,  tliose  that  meet  the  time-urgency 
requirement  and  tliose  that  do  not. 


WUNHITC IDLOW) 

sets  the  allocation  of  weapons  to  targets  for  targets 
UNillT  in  the  first  pass.  IDLOW  is  the  index  of  the  current 
a  1 locat ion , 
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Appendix  B 

COMMON  BLOCKS  AND  VARIABLE  DEFINITIONS 

This  appendix  shows  the  FALCON  common  blocks  and  gives  a 
description  of  all  common  block  variables. 
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COMMON  BLOCKS 


ALLOC. CDE: 

INTEGER*4  ATNUM , AWTYP , WPT 

COMMON  /ALLOC/  NDXA , ICOP, INDX( 100 ,2) , AWTYP(300 , 3) , 

+  ATNUM(300) ,DEA(300,4) ,DEI (300) ,WPT(300) , 

+  DE0LD( 100) ,DENEW( 100) , ISC , IDG0( 100) ,MAXOBJ 

AWEAPS.CDE: 

CHARACTER*!  AWX(60) 

CHARACTER* 2  AWT (4, 60) 

COMMON  /AWEAPS/  NSALL, ICONT, IDXSA(60) , IUSE(2) ,NWA(2) , 

+  ISMOB(2),ISTIM(2,3),ISALT(2,3,2),ISDE(2,3,2,2) 

COMMON  /AWEAPC/  AWX.AWT 

FDNAM . CDE : 

CHARACTER* 1 2  TFNAME , WFNAME , SFNAME , OFNAME , AFNAME 
COMMON  /FDNAM/  TFNAME, WFNAME, SFNAME, OFNAME, AFNAME 


OBJ. CDE: 

CHARACTER*!  MDR(IOO) 

CHARACTER*3  ANDOR(IOO) 

CHARACTER* 12  WOC(100,2) 

CHARACTER*80  RUNNAM 
INTEGER*4  OPR,TGOFOR 

COMMON  /OBJ/  NOBJ , ICO,OPR( 100) ,0DE1 ( 100) ,0DE2 ( 100) ,TGOFOR( 100) 
COMMON  /OBJC/  woe, A.NDOR, RUNNAM, MDR 


PDES.CDE: 

COMMON  /PRDES  /  SDE(100,4,2) ,NOHIT1(100) ,NOHIT2(100) 


PRINT. CDE: 

INTEGER*2  TP1,TP2 

COMMON  /PRINT/  IPRINT, IPRCRX,TP1 ,TP2 


PRIO.CDE: 

COMMON  /PRIO/  NIP,IPRIO(100) 
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RULES. CDE: 

CHARACTER* 1  ARATE , AORDER , CASE , I SSPK , I PLS , ARWOC , TSORT , 

+  IPASS2 , TLSORT , ARLEG , ARSAM , PORDER , IDEP , 

+  ARMOF,ARFOM.ARTU,ARDE,P2 

COMMON/RULES/  ARATE , AORDER, CASE , ISSPK, I PLS , ARWOC , TSORT, 

+  I PASS2 , TLSORT , ARLEG , ARSAM , PORDER , IDEP ( 2 ) , 

+  ARMOF , ARFON , ARTU , ARDE , P2 ( 2 , 5 ) 

SSPKDE.CDE: 

COMMON  /SSPKDE/  DE(100,60) 

TARGT.CDE: 

CHARACTER*!  M0BT(]00) ,VNTK2(100) 

CHARACTER*12  TOBJ(IOO) 

INTEGER*4  TNUM,TUR,VNTK1 ,VNTK3 

COMMON  /TARGT/  TNUM(IOO) , PDET( 100) ,TUR(100) ,R95(100) ,AZMTH(100J, 
+  OFF(100),VNTKI(100),VNTK3(100) ,DMIN(100) 

COMMON  /TARGTC/  T0BJ,M0BT,VNTK2 

WEAPS.CDE: 

CHARACTER* 10  WNAM 

CHARACTER*4  WCAT 

CHARACTER*!  MOBW,WLEG 

INTEGER*4  A INV , WTU , WPR , YLD , CEP , WPMAX , HOB 

COMMON  /WEAPS/NWTYP,WPR(60) ,WTU(60) ,NW(60) ,WAV(60) ,NWTH(60) , 

+  PWTH(60) ,WAG(60) ,WAD(60) ,PLSS(60,4) , 

+  RELL(60) ,RELI (60) ,RELW(60) ,PTPS(60,4) ,YLD(60) , 

+  CEP(60) ,H0B(60) ,PLS(60) .PTP(60) ,AINV(60) , 

+  AINVAL(60)  ,AINWL(60)  .AINVRL(60)  ,AINVNS(60) , 

+  A1NVT(60),NMAX,WPNAX 

COMMON  /WEAPSC/  W.NAM(60)  ,WCAT(60)  ,WLEG(60)  ,M0BW(60) 
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VARIABLE  DEFINITIONS 


AFNAME 

AINV(I) 


AINVAL(I) 


AINVNS(I) 


AINVRL(I) 


AINVT(I) 


The  character*12  name  of  the  audit  trail  output  file  i 

Common :  /FDNAM/ 

The  current  allocatable  inventory  of  Weapon  I  accounting 
for  losses  and  alert  rates. 

Use:  If  80  of  the  110  weapons  of  Weapon  0  are 

currently  allocatable, 

AINV(3)  =  80 
Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  inventory  of  Weapon  I  unallocatable  because  of 
availability  losses. 

Use:  If  90  of  the  110  weapons  of  Weapon  3  are 

unallocatable  because  of  availability, 

AINVAL(3)  =  90 
Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  inventory  of  Weapon  I  not  surviving.  This  array 
functions  only  when  the  prelaunch  survivability  is 
used  to  decrement  the  number  of  allocatable  weapons. 

Use:  If  the  PLS  for  the  100  weapons  of  Weapon 

3  is  70?o  and  the  PLS  is  accounted  for  by 
reducing  allocatable  weapons; 

AINVNS(3)  =  30 
Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  inventory  of  Weapon  I  unallocatable  because  of  alert  rate. 
Use:  If  90  of  the  110  weapons  of  Weapon  3  are 

unallocatable  because  of  alert  rate, 

AINVRL(3)  =  90 
Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  initial  allocatable  inventory  of  Weapon  I. 

Use:  If  90  of  the  110  weapons  of  Weapon  3  are 

initially  allocatable, 

AINVT(3)  =  90 
Common;  /WEAPS/ 

Limits:  I.LE.NWTYP 


I.LE.60 
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AINWL(I) 


ANDOR(I) 


A0RDF.R 


ARATE 


ARDE 


The  inventory  of  Weapon  I  withheld. 

Use:  If  90  of  the  110  weapons  of  Weapon  3  are 

withheld, 

AINVWL(3)  =  90 
Common:  /WEARS/ 

Limits:  I.LE.IWTYP  I.LE.60 

The  c.haracter*3  logical  expressions  that  relate  whether 
one  "and/or"  a  second  weapon  of  choice  are  to  be  used 
for  Objective  I. 

Use:  For  Objective  3,  which  requires  both  weapons  of 

choice  be  used  together, 

AND0R(3)  -  "AND" 

Common:  /OBJC/ 

Limits:  I.LE.NOBJ  I.LE.60 

Character*!  rule  to  allow  the  user  the  option  to 
distinguish  weapons  by  alert  rate.  This  applies  only  when 
ARATE  =  "G". 

Use:  1  -  Distinguish  weapons  by  alert  rate:  for  each 
weapon  type  entered  in  the  weapons  file, 
distinguish  between  those  weapons  which  are  on 
day-to-day  alert  (denoted  by  a"d_"  prefixing  the 
weapon  type)  and  those  weapons  which  are 
additionally  available  on  generated  alert 
(denoted  by  a  "g_"  prefixing  the  weapon  type). 

2  -  Do  not  distinquish  priority  by  alert  rate  of 
weapon  (default). 

No  other  prioritization  of  weapons,  based  on  alert  rate, 
is  allowed. 

Common:  /RULES/ 

Limits:  AORDER  .EQ.  I  or  2 

Character*!  flag  for  the  alert  rate  type. 

Use:  ARATE  =  G  -  Generated  alert  (default) 

ARATE  =  D  -  Day-to-day  alert 
Common:  /RULESC/ 

Limits:  ARATE. EQ.G  or  D 

Character*!  rule  tell  whether  DE  requirement  can  be 
relaxed. 

Use:  ARDE  =  1  -  Do  not  allow  relaxation  of  DE 

requirement . 

=  2  -  Allow  relaxation  of  DE  requirement 
(default) . 

Common:  /RULES/ 

Limits:  ARDE  .EQ.  1  or  2 
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ARFOM 


ARLEG 


ARMOR 


ARSAM 


Character*!  rule  to  tell  whether  nonmobile-capable  weapons 
may  be  used  against  mobile  targets. 

Use:  ARFOM  =  1  -  Do  not  allow  nonmobile-capable  weapons 
to  be  used  against  mobile  targets. 

=  2  -  Allow  nonmobile-capable  weapons  to  be 
used  against  mobile  targets  (default). 

Common:  /RULES/ 

Limits:  ARFOM  .EQ.  1  or  2 

Character*!  rule  for  Pass  2  (and  for  TLSORT  =  3  only-- 
otherwise  ARLEG  is  ignored)  to  tell  whether  to  allow  the 
second  weapon  allocated  to  be  from  the  same  leg  of  the 
Triad  as  the  one  allocated  in  Pass  1. 

Use:  ARLEG  =  1  -  In  Pass  2,  do  not  allow  the  second  weapon 
to  be  from  the  same  Triad  leg  as  the  one 
allocated  in  Pass  1. 

=  2  -  In  Pass  2,  allow  the  second  weapon  to  be 
from  the  same  leg  as  the  one  allocated 
in  Pass  1  (default). 

Common:  /RULES/ 

Limits:  ARLEG  .EQ.  1  or  2 

Character*!  rule  to  tell  whether  mobile-capable  weapons  may 
be  used  against  fixed  targets. 

Use:  ARMOF  =  1  -  Do  not  allow  mobile-capable  weapons  to  be 
used  against  fixed  targets. 

=  2  -  Allow  mobile-capable  weapons  to  be  used 
against  fixed  targets  (default). 

Common:  /RULES/ 

Limit  ■  ARMOF  .EQ.  1  or  2 

Character*!  rule  for  Pass  2  (and  for  TLSORT  =  3  on!y-- 
otherwise  ARSAM  is  ignored)  to  te!!  whether  to  allow  the 
second  weapon  allocated  be  the  same  weapon  as  the  one 
allocated  in  Pass  1. 

Use:  ARSAM  =  1  -  In  Pass  2,  do  not  allow  the  second  weapon 
be  the  same  weapon  as  the  one  allocated 
in  Pass  1 . 

=  2  -  In  Pass  2,  allow  the  second  weapon  to 

be  the  same  weapon  as  the  one  allocated 
in  Pass  1  (default). 

Common:  /RULES/ 

Limits:  ARSAM  .EQ.  1  or  2 
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ARTU 


ARWOC 


ATNUM(I) 


AWT(I .J) 


Character*!  rule  to  tell  whether  time-urgency  requirement 
can  be  relaxed. 

Use:  ARTU  =  1  -  Do  not  allow  relaxation  of  time- 

urgency  requirement. 

=  2  -  Allow  relaxation  of  time-urgency 
requirement  (default). 

Common:  /RULES/ 

Limits:  ARTU  .EQ.  1  or  2 

Character*!  rule  to  tell  whether  to  relax  Pass  1  requirement 
for  the  weapon  of  choice. 

Use:  ARWOC  =  1  -  In  Pass  1,  do  not  allow  relaxation 
of  the  weapon  of  choice  requirement. 

=  2  -  In  Pass  1,  allow  relaxation  of  the 

weapon  of  choice  requirement  (default). 

Common:  /RULES/ 

Limits:  ARWOC  .EQ.  1  or  2 

The  number  of  weapons  allocated  in  Allocation  I. 

Use:  If  90  weapons  each  of  a  particular  weapon  or  weapon 

pair  arc  the  second  group  of  weapons  to  be  allocated 
in  either  pass. 

ATNUM  (2)  =  90 
Common :  /ALLOC/ 

Limits:  I.LE.3*N0BJ  I.LE.300 


Charactcr*2  ."rray  that  gives  the  characteristics  of 
Weapon  J  for  the  current  objective,  where: 

1=1-  Designates  the  mobile-capability  of  the 
weapon . 

=  2  -  Designates  the  time-urgency  capability 
in  Pass  1  and  the  leg  of  the  Triad  (or 
timing)  in  Pass  2. 

=  3  -  Designates  the  alert  rate  of  the  weapon. 

=  4  -  Designates  whether  the  weapon  meets  the 
I)E  requirement  of  the  objective. 

Use:  AWT(1,J)  =  ".M  "  -  Weapon  J  is  a  mobile-capable 

weapon. 

AWT(2,J)  =  "TU"  -  Weapon  J  is  a  time-urgent  weapon 
for  Pass  1  allocation  and 


TSOKT.EQ. "2". 

"Y  "  -  Weapon  J  meets  the  time-urgency 
requirement  in  either  pass  where 
weapons  are  sorted  solely  by  whether 
they  meet  the  time-urgency 
requirement . 

"l  "  -  Weapon  J  is  an  ICB.M  for  Pass  2 
weapons  sorted  by  Triad  Leg. 

AWT(3,J)  =  "G  "  -  Weapon  J  is  on  generated  alert 
AWT(4,J)  =  "Y  "  -  Weapon  J  meets  the  DE  requirement 
of  the  current  objective 
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AWX(I) 


AWTYP(I,J) 


AZMTH(I) 


CASE 


CEP(I) 


DE(I,J) 


Common:  /AWEAPC/ 

Limits:  I. LE. 1,2,3  or  4 

J.LE.NSALL  J.LE.60 

Character*!  array  that  tells  whether  Weapon  I  for  the 
current  objective  meets  all  requirements  for  allocation. 

Use:  AWX(I)  =  "N"  -  Weapon  1  does  not  meet  all  the 

requirements  for  allocation  to  this 
objective . 

=  "Y"  -  Weapon  I  does  meet  all  the 

requirements  for  allocation  to  this 
objective. 

Common:  /AWEAPC/ 

Limits:  I.LE.NSALL  I.LE.60 

The  weapon  type  of  Allocation  I  for  Pass  J. 

Use:  If  Weapon  17  is  the  Pass  1  weapon  of  the  fifth 

allocation  and  Weapon  4  is  the  Pass  2  weapon 
allocated  to  Weapon  4, 

AWTYP  (5,1)  =  17  and  AWTYP  (5,2)  =  4 
Common:  /ALLOC/ 

Limits:  I.LE.3*N0BJ  I.LE.300 

J.EQ.  1  or  2 

For  equivalent  target  area  (ETA)  targets,  the  azimuth  from 
DGZ  to  target  for  Target  I  in  degrees. 

Use:  If  Target  25  is  an  ETA  target  with  azimuth  of 
30  degrees,  then 

AZHTH(25)  =  30. 

Common :  /TARGT/ 

Limits:  I.LE.NOBJ  I.LE.lOO 

Character*!  designation  for  launch  strategy. 

Use:  U  -  Delayed  launch 

P  -  Prompt  launch  (default) 

Common:  /RULES/ 

Limits:  CASE  .EQ.  1  or  2 

The  CEP  (circular  error  probable)  for  Weapon  I,  in  feet. 

Use:  For  Weapon  5  having  a  CEP  of  50  feet, 

CEP(5)  =  50 
Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

Damage  expectancy  of  Weapon  J  against  Target  I  (SSPK  of 
Weapon  J  against  Target  1  modified  for  reliabilities  and  air 
defense  estimation). 

Use:  For  Weapon  3  with  total  DE  of  80%  against  Target  4, 

DE(4,3)  =  .8 


Common:  /SSPKDE/ 
Limits:  I.LE.NOBJ 
J.LE.N\vTYP 
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DEA(I,J) 


DEI  (I) 


DENEW(I) 


DEOLD(I) 


DMIN(I) 


I. LE. 100 

J. LE.60 

The  DE  of  the  weapon  or  pair  in  Allocation  I  for  each  of 

the  four  scenarios, 

where: 

J  =  1  -  Delayed  launch,  day-to-day  alert 
=  2  -  Prompt  launch,  day-to-day  alert 
=  3  -  Delayed  launch,  generated  alert 
=  4  -  Prompt  launch,  generated  alert 
Use:  For  a  prompt  launch,  day-to-day  alert 

scenario,  if  Weapon  5  ic  the  fourth  type  of 
weapon  to  be  allocated  to  any  objective,  and  this 
weapon  has  a  DE  of  89%  against  this  target, 

DEA(4,1)  =  .89 

Common:  /ALLOC/ 

Limits:  I.LE.3*N0BJ  I.LE. 300 

J.EQ  1,2,3  or  4 

The  total  DE  of  the  current  objective  after  Allocation  I 
has  been  applied. 

Use:  If  the  total  DE  for  the  current  objective  equals 

80%  after  the  second  weapon  type  has  been  allocated 
(and  this  is  the  25th  allocation  overall) 

DEI(25)  =  .80 
Common:  /ALLOC/ 

Limits:  I.LE.*30NOBJ  I.LE. 300 

The  current  total  DE  achieved  for  Objective  I. 

Use:  If  the  total  current  DE  for  Objective  10  is  90%, 

DENEW(IO)  =  .90 
Common:  /ALLOC/ 

Limits:  I.LE.NOBJ  I.LE. 100 

The  total  DE  achieved  for  Objective  I  before  the 
current  allocation. 

Use:  If  the  total  DE  for  Objective  10  before  the 

current  allocation  was  80%, 

DEOLD  (10)  =  .80 
Common:  /ALLOC/ 

Limits:  I.LE.NOBJ  I.LE. 100 

The  minimum  weapon-per-target  DE  allowable  for  allocation 
against  Target  I. 

Use:  If  the  minimum  DE  allowed  against  Target  9  is  70%, 

DMIN(9)  =  .70 
Common :  /TAROT/ 

Limits:  I.LE.NOBJ 


I.LE. 100 
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HOB(I) 


ICO 


ICONT 


ICOP 


IDEP(I) 


IDGO(I) 


The  height  of  burst  in  feet  for  weapon  type  I. 

Use:  If  HOB  =  -1,  the  optimum  height  of  burst  will  be 

computed.  HOB(I)  =  1000 
Common:  /WEAPS/ 

Limits:  I.LE.Nh'TYP  I.LE.60 

The  index  of  the  current  objective. 

Common:  /OBJ/ 

Limits:  ICO.LE.NOBJ 

The  index  showing  whether  any  weapons  meet  the  current 
requirement  (e.g.  mobility,  time  urgency,  etc.) 

Values:  0  -  No  weapons  are  available  that  meet  the 

requirement  and  the  requirement  cannot  be 
relaxed. 

1  -  No  weapons  are  available  that  meet  the 

requirement,  but  the  requirement  can  be 
relaxed. 

2  -  At  least  one  weapon  meets  the  requirement. 
Common:  /AWEAPS/ 

Limits:  ICONT. EQ.  0,  1,  or  2 

The  index  of  the  current  objective  in  prioritized  order 
Common:  /ALLOC/ 

Limits:  ICOP.LE.NOBJ 

Character*!  rule  for  Pass  1  to  determine  whether  the  DE 
goal  must  be  met  by  each  individual  target  or  whether  the 
goal  DE  must  be  met  as  a  mean  DE  for  the  whole  target 
objective. 

Use:  1  -  Require  the  goal  DE  be  met  by  each  individual 

target  in  the  objective. 

2  -  Require  the  goal  DE  be  met  as  a  mean  DE  for  the 
objective  (default). 

If  the  DE  goal  is  to  be  met  as  an  individual  DE  in 
Pass  1  and  a  mean  DE  on  Pass  2: 

IDEP(l)  =  1 

IDEP(2)  =  2 

Common:  /RULES/ 

Limits:  IDEP(I)  .EQ.  1  or  2 

J  .EQ.  1  or  2 

An  array  used  in  the  allocation  methodology  to  tell  FALCON 
when  to  go  on  to  the  next  (I  +  1)  allocation, 

IDGO(I)  =  1  -  Proceed  to  Allocations  I  +  1. 

IDGO(I)  =  0  -  Continue  with  current  allocation. 
Common:  /ALLOC/ 

Limits :  I . LE . 3*NOBJ 


I.LE.50 
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IDXSA(I) 


INDXd.J) 


IPASS2 


IPLS 


I PKCRX 


1  PRINT 


The  array  of  ordered,  allocatable  single  weapons. 

Use:  If  the  third  highest  priority  allocatable  weapon  is 

Weapon  7,  then: 

IDXSA(3)  =  7. 

Common:  /AWEAPS/ 

Limits:  I.LE.NSALL  I.LE.60 

The  indices  of  the  start  (J  =  1)  and  end  (J  =  2)  indices  of  the 
allocation  arrays  for  Objective  I. 

Use:  If  allocations  for  Objective  10  are  stored  in  the 

allocation  arrays  beginning  at  Index  7  and  going 
through  Index  24 

INDXdO.l)  =  7 

INDXdO,2)  =  24 
Common:  /ALLOC/ 

Limits:  I.LE.NOBJ  I.LE.lOO 

J.EQ.  1  or  2 

Character*!  rule  designating  whether  a  second  pass  allocation 
should  be  made. 

Use:  1  -  Do  not  allocate  weapons  in  Pass  2  (i.e.,  turn  off 

Pass  2) 

2  -  Perform  Pass  2  allocations  (default) 

Common:  /RULES/ 

Limits:  IPASS2  .EQ.  1  or  2 

Character*!  rule  designating  how  the  prelaunch 
survivability  is  to  be  used. 

Use:  1  -  Use  the  PLS  (prelaunch  survivability)  to 

decrease  the  number  of  allocatable  weapons. 

2  -  Use  the  PLS  (prelaunch  survivability)  to 
reduce  the  weapon-target  damage  expectancy. 

Common:  /RULES/ 

Limits:  IPLS  .EQ.  1  or  2 

Print  flag  for  cross-cases. 

Use:  1  -  Turn  off  cross-cases;  print  output  for  allocation 

scenario  only. 

2  -  Turn  on  cross-cases;  print  output  for  all  four 
scenarios  (default). 

Common:  /PRINT/ 

Limits:  /PRCRX.EQ.  1  or  2 

Print  flag. 

Use:  0  -  No  diagnostic  print  (default). 

1  -  Selected  diagnostic  print. 

2  -  Full  diagnostic  print. 

Common:  /PRINT/ 

Limits:  IPRINT.EQ.O,  1 ,  or  2 
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IPRIO(I) 


ISALT(I,J,K) 


ISC 


ISDE (I ,J.K,L) 


ISMOIKD 


ISTIMCl ,J) 


ISSPK 


Array  of  target  objectives  in  priority  order. 

Use:  For  five  phase  objectives,  the  last  objective  in  the 

phase  having  the  highest  priority, 

IPRIO(l)  =  5 
Common:  /PRIO/ 

Limits:  I.LE.NIP  I.LE.lOO 

The  array  of  weapons  ordered  by  mobility  (1  =  1-2  for  mobile 
and  nonmobile  weapons),  time  urgency  (J  =  1,2  or  3  for 
time-urgent,  time-sensitive  or  nontime-sensitive  in  Pass  1  or 
ICBM,  SLBM  or  AIR  in  Pass  2),  and  alert  rate  (K  =  1  or  2  for 
day-to-day  or  generated  alert  rate). 

Common:  /AWEAPS/ 

The  index  of  the  allocation  scenario: 

Use:  1  -  Delayed  launch,  day-to-day  alert 

2  -  Prompt  launch,  day-to-day  alert 

3  -  Delayed  launch,  generated  alert 

4  -  Prompt  launch,  generated  alert 
Common:  /ALLOC/ 

Limits:  ISC.EQ.  1,2,3  or  4 

The  array  of  weapons  ordered  by  mobility  (I  =  1-2  for  mobile 
and  nonmobile  weapons),  time  urgency  (J  =  1,2  or  3  for 
time-urgent,  time-sensitive  or  nontime-sonsitive  weapons  in 
Pass  1  or  ICBM,  SLBM  or  AIR  in  Pass  2),  alert  rate  (K  =  1  or 
2  for  day-to-day  or  generated  alert  rate),  and  whether  the 
weapon  meets  the  target  DE  requirement  (L  =  1  or  2  for  "does 
meet"  or  "does  not  meet"  the  requirement). 

Common:  /AWEAPS/ 

Tlio  array  of  weapons  ordered  by  mobility  (I  =  1-2  for  mobile 
and  nonmobile  weapons). 

Common:  /AWEAPS/ 

Tlie  array  of  weapons  ordered  by  mobility  (I  =  1-2  for  mobile 
and  nonmobile  weapons)  and  time  urgency  (J  =  1,2  or  3  for 
Lime-urgent,  time-sensitive  or  nontime-sensitive  weapons  in 
Pass  1  or  ICBM,  SLBM  or  AIR  in  Pass  2). 

Common:  /AWEAPS/ 

Character''' 1  designation  for  method  to  generate  SSPK  table. 
Use:  1  -  User  input  SSPK  table  is  used. 

2  -  Use  formula  to  calculate  SSPK. 

3  -  PDCLC4  generates  SSPK  table  (default). 

4  -  Use  formula  and  input  SSPK  table. 

5  -  Use  PDCLC4  and  input  SSPK  cable. 

Common;  /RULES/ 

Limits;  I SSPK  .EQ.  1,  2,  3,  4,  or  5 


78 


lUSE(I) 


MAXOBJ 


MDR(I) 


MOBT(I) 


MOBW(I) 


NDXA 


NIP 


Array  of  indices  of  weapon  types  to  be  used  in  the  allocation. 
Use:  If  weapons  3  and  4  are  to  be  allocated  then, 
lUSE(l)  =  3 
IUSE(2)  =  4 
Common:  /AWEAPS/ 

Limits :  I .EQ. 1  or  2 

The  maximum  number  of  objectives  allowed. 

Common:  /ALLOC/ 

Limits:  MAXOBJ  =  100 

The  character*!  rule  designating  whether  the  goal  DE  for 
Objective  I  must  be  met  before  making  allocations  to 
subsequent  objectives. 

Use:  "*"  -  DE  goal  for  Objective  I  must  be  met  before 

proceeding  to  subsequent  objectives. 

"  "  -  DE  goal  need  not  be  met  before  proceeding  to 
subsequent  objectives. 

Common:  /OBJ/ 

Limits:  I.LE.NOBJ  I.LE.lOO 

Character*!  mobility  designation  for  Target  Objective  I. 

Use:  If  Target  Objective  3  is  mobile, 

M0BT(3)  =  "M" 

If  Target  Objective  4  is  fixed, 

N0BT(4)  =  "  "  or  "F" 

Common:  /OBJC/ 

Limits:  I.LE.NOBJ  I.LE.lOO 

Character*!  designation  for  the  mobile  capability  of 
Weapon  I . 

Use:  If  Weapon  5  is  mobile-capable, 

MOBW  (5)  =  "M" 

If  Weapon  6  is  not  mobile-capable, 

M0BW(6)  =  "F"  or  "  " 

Common:  /WEAPSC/ 

Limits:  I.LE.N'WTYP  I.LE.60 

The  total  number  of  allocations  made  for  the  current 
execution. 

Common:  /ALLOC/ 

Limits:  NDXA .  LE .  3*N0BJ  ND.XA.LE.300 

The  lowest  priority  (highest  number)  of  the  objectives  to 
be  evaluated. 

Use:  If  there  are  five  objectives  in  the  targets  data 

file,  and  the  objective  of  lowest  priority  has  a 
priority  number  of  7,  NIP  =  7 
Common:  /PR 10/ 

Limits:  NIP. LE. 100 
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NMAX 


NOHITl(I) 


NOHIT2(I) 


NOBJ 


NSALL 


NW(I) 


NWA(I) 


NWTll(I) 


The  maximum  number  of  weapon  types  allowed. 

Common:  /WEAPS/ 

Limits:  NMAX. EQ. 60 

The  number  of  targets  unhit  for  Objective  I  after  Pass  1. 

Use:  If  25  targets  of  Objective  13  remain  unhit  after  Pass  1, 

N0HIT1(13)  =  25 

Common:  /PDES/ 

Limits:  l.LE.NOBJ  I.LE.lOO 

The  number  of  targets  unhit  for  Objective  I  after  Pass  2. 

Use:  If  35  targets  of  Objective  3  remain  unhit  after  Pass  2, 

NOHIT2(3)  =  35 

Common:  /PDES/ 

Limits:  l.LE.NOBJ  I.LE.lOO 

The  number  of  target  objective  types  in  the  target  data 
f  ile . 

Common:  /OBJ/ 

Limits:  1 . LE .NOBJ . LE . 100 

The  number  of  entries  in  the  array  of  ordered,  allowable 
weapons,  IDXSA. 

Use:  If  there  are  5  entries  in  IDXSA, 

NSALL  =  5. 

Common:  /AWEAPS/ 

Limits:  NSALL. LE. 100 

Total  number  of  weapons  of  Weapon  I. 

Use:  If  there  are  1920  of  Weapon  3, 

NW(3)  =  1920 
Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

Number  of  single  weapons  (I  =  1)  or  weapon  pairs  (I  =  2) 
available  for  allocation  to  the  current  objective. 

Use:  If  392  weapons  of  Weapon  16  are  available  for 

allocation  to  the  current  objective,  along  with 
42  of  Weapon  17  as  a  weapon  pair, 

.NWAd)  =  392  and  N'WA(2)  =  42 
Common:  /AWEAPS/ 

Limits :  I .EQ. 1  or  2 

The  number  of  Weapon  I  to  be  withheld.  If  50 
of  Weapon  4  are  to  be  withheld  from  the  allocation. 

Use:  .SWTH(4)  =  50 

Common:  /WEAPS/ 

Limits:  I.LE.N'WTYP 


I.LE.60 
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N\v'TYP 


ODEl(I) 


0DE2(I) 


OFF(I) 


OFN'AME 


OPU(I) 


P2(I.J) 


Total  number  of  weapon  types. 

Common:  /WEAPS/ 

Limits:  NWTYP.LE.bO 

Array  of  damage  expectancies  to  be  achieved  for  each 
Objective  I  in  Pass  1. 

Use:  For  Objective  2,  having  a  Pass  1  DE  goal  of  90%, 

0DE1(2)  =  .9 

Common:  /OBJ/ 

Limits:  l.LE.lOO 

Array  of  damage  expectancies  to  be  achieved  for  each 
Objective  I  in  Pass  2. 

Use:  For  Objective  2,  having  a  Pass  2  DE  goal  of  90%, 

0DE2(2)  =  .9 

Common:  /OBJ/ 

Limits :  I . LE . 100 

The  offset  (the  distance  between  the  target  and  the  aim 
point)  of  Target  1  in  nautical  miles. 

Use:  I.'  the  offset  for  Target  13  is  0, 

0FF(13)  =  0. 

Common:  /TARGT/ 

Limits:  I.LE.NOBJ  l.LE.lOO 

The  charactor*12  name  of  the  output  file  whore  results  will 
bo  printed. 

Common:  /FD.S'AM/ 

The  priority  of  Objective  1. 

Use:  If  tlie  third  objective  has  the  highest  priority, 

0PK(3)  =  1. 

Common:  /OliJ/ 

Limits:  l.Li:..N'0BJ  NOBJ.LE.IOO 

Array  for  storing  the  character*!  FAI.CON  rules  that  change 
between  passes: 

1  =  1  or  2  for  Pass  1  or  Pass  2 

J  =  1  -  5  for  each  of  the  following  rules  that  can 

cliange  between  parses;  PURDER,  ARFO.M,  ARMOF, 
ARTU  and  ARDE 
Common:  /RULES/ 

Limits:  I  .EQ.  1  or  2 

1  .LE.  J  .LE.  5 
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PDET(I) 


PLS(I) 


PLSSd.J) 


PORDER 


The  probability  of  detection  for  Target  Objective  I. 
(Probabilities  of  detection  for  all  fixed  targets  are  1.0.) 
Use:  If  the  probability  of  detection  for  Obiective  3 

is  50%, 

PDET(3)  =  .50 
Common:  /OBJ/ 

Limits:  I.LE.NOBJ 

I. LE. 100 

For  the  current  execution  scenario,  the  total  prelaunch 
survivability  factor  for  Weapon  Type  I.  For  the  launch- 
under-attack,  generated  alert  scenario,  PLS(I)  will  be 
set  to  PLSLG(I);  for  the  ride-out  attack  scenario,  PLS(I) 
will  be  set  to  PLSRD(I),  etc. 

Use:  If  the  losses  due  to  PLS  for  Weapon  4  are  30%, 

PLS(4)  =  .3 
Common:  /WEAPS/ 

Limits:  I.LE.WTYP  I.LE. 60 

The  prelaunch  survivabilities  of  weapon  I  for  the 
four  scenarios,  where: 

J  =  1  -  Ride-out  attack,  day-to-day  alert 
=  2  -  Launch-under  attack,  day-to-day  alert 
=  3  -  Ride-out  attack,  generated  alert 
=  4  -  Launch-under-attack,  generated  alert 
Use:  If  the  PLS  of  Weapon  7  for  the  launch-under¬ 

attack,  generated  alert  scenario  is  85%, 

PLSLG(7,4)  =  .85 
Common:  /WEAPS/ 

Lii„its:  I.LE.NWTYP  I.LE. 60 

J. EQ.  1,2,3  or  4 

Character*!  rule  to  sol  the  final  ordering  of  weapons  after 
they  lidve  been  ordered  by  whether  they  meet  the  DE  goal. 
Use:  1  -  Order  weapons  that  meet  the  DE  goal  from  lowest 

DE  to  highest  DE  and  then  order  weapons  that  do 
not  meet  the  DE  goal  from  highest  DE  to  lowest 
DE  (default). 

2  -  Order  weapons  that  meet  the  DE  in  priority 
order.  Then  order  weapons  that  do  not  meet 
the  DE  in  priority  order. 

Common:  /RULES/ 

Limits:  F’OKDER  .EQ.  1  or  2 
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PTP(I) 


PTPS(I,J) 


PWTH(I) 


RELI(I) 


RELL(I) 


RELV(l) 


For  the  current  FALCON  scenario,  the  probability  of  Weapon  I 
to  penetrate  terminal  defenses.  PTP(I)  will  be  set  to 
PTPLD(I)  if  the  current  execution  is  for  launch-under- 
attack,  day  alert;  PTP(I)  will  be  set  to  PTPLG(I)  if  the 
current  execution  is  for  generated  alert,  launch-under¬ 
attack,  etc. 

Use:  For  Weapon  No. 3,  with  PTP  =  60%, 

PTPD(3)  =  .6 
Common:  /UEFNS/ 

Limits:  I.LE.NVTYP  I.LE.60 

The  probability  to  penetrate  for  Weapon  I  for  the  four 
scenarios ,  where: 

J  =  1  -  Ride-out  attack,  day-to-day  alert 
=  2  -  Launch-under  attack,  day-to-day  alert 
=  3  -  Ride-out  attack,  generated  alert 
=  4  -  Launch-under-attack,  generated  alert 
Use:  If  the  PTP  of  Weapon  7  for  the  launch-under¬ 

attack,  generated  scenario  is  85%, 

PTPLG(7,4)  =  .85 
Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

J.EQ.  1,2,3  or  4 

The  percentage  of  Weapon  I  to  be  withheld. 

Use:  If  10?ii  of  Weapon  7  is  to  be  withhe.d  from 

the  allocation, 

PWTH(7)  =  .10 

Common :  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  in-flight  reliability  for  Weapon  I. 

Use:  If  the  in-flight  reliability  for  Weapon  6  is  95?o, 
RELI(6)  =  .95 
Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  launch  reliability  for  Weapon  I. 

Use:  If  the  launch  reliability  for  Weapon  6  is  90%, 

RELL(6)  =  .90 
Common:  /WEAPS/ 

Limits:  I.LE.NVTYP  I.LE.60 

The  warhead  reliability  for  Weapon  I. 

Use:  If  the  warhead  reliability  for  Weapon  6  is  92?ii, 

REL1(6)  =  .92 
Common:  /WEAPS/ 

Limits:  I.LE..NWTYP  I.LE.60 
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RUNNAM 


R95(I) 


SDta.J.K) 


SFNAME 


TNUM(I) 


TFNAME 

TGOFOR(I) 


The  character*80  descriptive  name  for  the  current 
execution  of  FALCON. 

Use:  If  the  current  run  name  is  "1984_CASE"  then 

RUNNAM  =  "1984_CASE" 

Common:  /OBJC/ 

The  R95  value  (the  radius  of  a  circlf  -hat  contains  95% 
of  the  target  area)  for  Target  Objective  I,  in  nautical 
miles.  For  eta  targets  (types  A,  B,  C,  D,  or  E) 

R95xl0  equals  the  orientation  of  the  target  in  degrees. 

Use:  For  Target  Objective  3  with  an  R95  of  0., 

R95(3)  =  0. 

Common:  /TARGT/ 

Limits:  0.LE.R95  I.LE.lOO 

The  achieved  DE  for  Objective  I,  Scenario  J,  Pass  K,  where 
J  =  1  -  Delayed  response,  day-to-day  alert 
=  2  -  Prompt  launch,  day-to-day  alert 
=  3  -  Delayed  response,  generated  alert 
=  4  -  Prompt  launch,  generated  alert 
K  =  1  -  Pass  1 
2  -  Pass  2 

Use:  If  the  DE  achieved  for  Objective  5  after  Pass  1  is  72% 
for  the  day-to-day,  delayed  response  scenarios, 

SDE  =  .72 

Common:  /PDES/(5 , 1 , 1) 

Limits:  I.LE.NOBJ  I.LE.lOO 

J. EQ.  1,2,3  or  4 

K. EQ.  1  or  2 

The  character*12  name  of  the  input  file  containing  SSPK 
data . 

Common:  /FDN.AM/ 

The  number  of  targets  of  target  Objective  I. 

Use:  If  there  are  1200  of  Target  3, 

TNUM(3)  =  1200 
Common:  /TARGT/ 

Limits:  I.LE..N0BJ  I.LE.lOO 

The  character* 12  name  of  the  input  file  for  targets  data. 
Common:  /FDNAM/ 

The  number  of  targets  currently  unhit  in  Target  Objective  I. 
Use:  If  300  of  the  500  targets  of  Objective  9  are  unhit, 

TG0F0R(9)  =  300 

Common:  /OBJ/ 

Limits:  I.LE.NOBJ 


I.LE.lOO 


TOBJ(I) 


The  character*12  name  of  Target  Objective  I. 

Use:  T0BJ(2)  =  "NUC.TargetlO" 

Common:  /TARGTC/ 

Limits:  I.LE.NOBJ  I.LE.lOO 

TSORT  Character*!  rules  designating  how  weapons  are  to  be  sorted 

by  timing  in  Pass  1: 

-  1  =  In  Pass  1,  sort  the  weapons  by  timing  into  two 

groups:  those  that  meet  the  time-urgency 
requirement  and  those  that  do  not. 

-  2  =  In  Pass  1,  sort  the  weapons  by  timing  into  three 

groups:  TU,  TS,  and  NTS--th'"  order  of  these 
groupings  will  depend  on  the  time  sensitivity  of 
the  target  (default). 

Common:  /RULES/ 

Limits:  TSORT. EQ.l  or  2 

TLSORT  Character  *1  rules  designating  how  rules  are  to  be  sorted 

by  timing  (or  Triad  leg)  in  Pass  2: 

-  1  =  In  Pass  2,  sort  the  available  weapons  by  timing-- 

Note:  if  this  option  is  selected,  weapons  will  be 
sorted  into  two  groups,  those  that  meet  the  time- 
urgency  requirement  and  those  that  do  not. 

-  2  =  In  Pass  2,  do  not  sort  weapons  by  timing  or  Triad  leg 

(i.e.,  skip  additional  sorting). 

-  3  =  In  Pass  2,  sort  the  available  weapons  by  Triad  leg 

(default) . 

Common:  /RULES/ 

Limits:  TLSORT. EQ  1,  2,  or  3 

TPl  The  priority  number  of  the  first  objective  for  which 

diagnostic  print  is  to  be  written  in  the  audit  trail. 

Use:  If  Objective  4  is  the  first  objective  for  which 

diagnostic  print  is  to  be  written, 

TPl  =  4 

Common:  /PRINT/ 

Limits:  TPl.LE.NOBJ  TPl. I.E.  100 

TP2  The  priority  number  of  the  last  objective  for  which 

diagnostic  print  is  to  be  written  in  the  audit  trail. 

Use:  If  Objective  16  is  the  last  objective  for  which 

diagnostic  print  is  to  be  written, 

TP2  =  16 
Common:  /PRINT/ 

Limits:  TP2.LE.N0BJ 


TP2.LE. 100 
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TUR(I) 


VNTKl(I) 


VNTK2(I) 


VNTK3(I) 


WAD(I) 


WAG(I) 


The  designation  for  time-urgency  requirement  of  Target 
Objective  I. 

Use:  If  Target  17  is  time-sensitive,  TUR(17)  =  2. 

Note; 

1  =  Time-urgent 

2  =  Time-sensitive 

3  =  Not-time-sensitive 
Common:  /TARGT/ 

Limits:  I.LE.NOBJ  I.LE.lOO 

TUR(I).EQ.1,2,  or  3 

The  "VN"  portion  of  VNTK  for  Target  Objective  I,  (If 
target  hardness  is  entered  by  the  user,  VNTKl(I)  is  read 
as  the  target  hardness,  a  F5.3  real  number.) 

Use:  For  Target  4  with  VNTK  of  20P0,  then 

VNTK 1(4)  =  20 
Common :  /TARGT/ 

Limits:  I.LE.NOBJ  I.LE.lOO 

The  "T"  portion  of  VNTK  for  Target  Objective  I,  specified  as 
character*!.  (If  target  hardness  is  input  by  the  user, 
VNTK2(I)  is  not  used.) 

Use:  For  Target  4  with  VNTK  of  20P0,  then 

VNTK2(4)  =  "P" 

Common:  /TARGTC/ 

Limits:  I.EQ.NOBJ  I.LE.lOO 

The  "K"  portion  of  VNTK  for  Target  Objective  I,  specified 
as  character*!.  (If  target  hardness  is  input  by  the  user, 
VNTK2(I)  is  not  used.) 

Use:  For  Target  4  with  VNTK  of  20P0,  then 
VNTK1(4)  =  0 
Common:  /TARGT/ 

Limits:  I.LE.NOBJ  I.LE.lOO 

The  day-to-day  alert  rate  for  Weapon  I. 

Use:  If  the  day-to-day  alert  rate  for  Weapon  4  is  89%, 

WAD (4)  =  .89 
Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  generated  alert  rate  for  Weapon  I . 

Use:  If  the  generated  alert  rate  for  Weapon  4  is  99%, 

WAG (4)  =  .99 
Common:  /WEAPS/ 

Limics:  I.LE.NWTYP  I.LE.60 
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WAV(I) 


WCAT(I) 


WFNAME 

WLEG(I) 


WNAM(I) 


WOC(I,J) 


WPMAX 


The  availability  factor  for  Weapon  I. 

Use:  For  Weapon  8  with  a  90%  availability, 

WAV(8)  =  .9 
Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  character*4  name  for  weapon  category  type  for  Weapon  I 

Use:  WCAT(3)  =  "SILO",  "RAIL"  or  "ROAD"  for  ICBMs 

_  "SEA,"  or  "STA",  for  SLBMS  and 

=  "ALCM‘,  "GRAV"  or  "SRAM"  for  Air  weapons 

Common:  /WEAPSC/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  character*12  name  of  the  weapons  data  input  file. 
Common :  /FDNAM/ 

The  character*!  designation  for  the  Triad  leg  of  Weapon  I. 
Use:  WLEG(3)  =  "l"  for  ICBM 

=  "S"  for  SLBM 
=  "A"  for  Air 

Common:  /WEAPSC/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  character*10  name  for  Weapon  I, 

Use:  WNAM(l)  =  "TRID5  " 

Common:  /WEAPSC/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  character*!2  weapons  of  choice  for  Objective  I. 

Use:  For  user  selection  of  SICBM  and  TRID5  for 

the  weapons  of  choice  for  Objective  4, 

W0C(4,1)  =  "SICBM  " 

W0C(4,2)  =  "TRID5  " 

If  there  is  only  one  (or  no)  weapons  of  choice, 
the  appropriate  variable  has  12  blank  spaces. 
Common:  /OBJC/ 

Limits:  I.LE.lOO 
J.EQ.2 

The  lowest  priority  weapon  (i.e.,  highest  number)  for  the 
weapons  specified. 

Use:  If  the  lowest  priority  of  all  weapons  input  is  45, 

WPMAX  =  45 


Common :  /WEAPS/ 
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WPR(I) 


WPT(I) 


WTU(I) 


YLD(I) 


The  priority  of  Weapon  I  as  specified  by  the  user;  1  is 
highest,  2  is  next  highest,  etc. 

Use:  For  three  weapons  in  descending  priority, 

WPW(l)  =  3 
WPW(2)  =  2 
WPW(3)  =  1 

Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  number  of  weapons  per  target  allocated  against  the 
current  objective  in  Allocation  I. 

Use:  WPT(I)  =  1  -  A  single  weapon  was  allocated  if  a 

weapon  was  allocated  in  only  one  pass, 
OR,  one  each  of  a  pair  of  weapons  was 
allocated  if  a  pair  was  allocated 
across  the  two  passes . 

=  2  -  Two  of  the  same  weapon  were  allocated 
in  a  single  pass. 

=  -1  This  is  the  first  of  a  pair  of  weapons 
allocated  in  a  single  pass. 

=  -2  This  is  the  second  of  a  pair  of  weapons 
allocated  in  a  single  pass. 

Common :  /ALLOC/ 

Limits:  I.LE.3*N0BJ  I.LE.300 

The  time-urgency  capability  of  Weapon  I. 

Use:  If  Weapon  3  can  be  used  for  time-sensitive  targets, 

WTU(3)  =  2.  Note: 

1  =  Time-urgent 

2  =  Time-sensitive 

3  =  Nontime-sensitive 

Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 

The  yield  for  Weapon  I  in  kilotons 
Use:  YLD(I)  =  1000. 

Common:  /WEAPS/ 

Limits:  I.LE.NWTYP  I.LE.60 
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Appendix  C 

COMPILING  AND  LINKING 


COMPILING 

To  comoile  FALCON  routines,  the  Microsoft®  Optimizing  FORTRAN 
compiler  (version  5.0)  was  used.  The  compile  command  used  is: 

fl  /c  /GtO  /Ox  xxxx.for 

where:  fl  executes  the  compilation 

/c  is  an  option  to  suppress  linking 

/GtO  is  an  option  that  affects  the  allocation  of  large  data 
blocks  by  causing  all  data  to  be  allocated  to  a  new  data 
segment  outside  the  default  data  segment 

/Ox  is  an  option  to  require  full  optimization  of  the  computer 
code 

xxxx.for  is  the  name  of  the  FORTRAN  subroutine  source  code. 

FALCON  was  compiled  with  the  FORTRAN  libraries  compatible  for  a 
math-co-processor.  If  your  machine  does  not  have  this,  the  FALCON 
subroutines  will  need  to  be  recompiled  with  the  appropriate  FORTRAN 
libraries.  The  documentation  for  the  Microsoft  compiler  should  be 
consulted  for  further  details  on  all  of  the  above. ^ 

LINKING 

Figure  C.l  shows  the  linking  instructions  required  to  generate  the 
FALCON  executable  code.  Sixty-five  subroutines,  not  including  those 
uniquely  called  by  PDCLC4,  and  13  common  blocks  are  required  to  support 
FALCON.  LLIBF0R7  is  a  Microsoft  support  library  containing  FORTRAN 
support  routines  (for  the  large  model).  The  option/SEGMENTS: 1024  allows 
linking  of  numerous  subroutine  segments. 


‘Microsoft  FORTRAN  version  5.0,  1989. 
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FALCON+ 

ABUMP+DNCALC+ERRMS4+EVALDE+0BPRI0+PDCALC+PDCLC4+ 

PDEXEC+RCAST1+RCAST2+READID+READ0D+READWD+REINIT+ 

REQDE+REQDE2+REQLEG+REQMOB+REQTIM+REQWOC+ROUT2A+ 

ROUT2B+ROUT20+-ROUT21+ROUT22+ROUT23+ROUT30+ 

ROUT40+RPOUT+RPOUT1+RPOUT2+RPOUT3+RPOUT4+ 

SCNDE1+SCNDE2+SCNDE3+SETDEF+SSPKT+SWOC+UOUT+ 

WALLC2+WALL0C+WC0UNT+WINVNT+WINV0+WNCALC+ 

WRHOB+WRITOD+WRSSPK+WSELCT+WSORT+WSORTA+ 

WSORTD+WSORTL+WSORTM+WSORTP+WSORTT+WSORT2+ 

WSPDE2+V,'SPRDE+WSRTA2+WSRTD2+WSRTT2+WUNHIT 

FALCON 

FALCON 

LLIBFOR7+ 

/SEGMENTS: 1024 


Fig.  C.l--Linking  instructions  for  FALCON 
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Append!);  D 

SAMPLE  AUDIT  TRAIL 


This  audit  trail  was  written  and  developed  primarily  to  present 
diagnostics  of  FALCON  execution  as  well  as  allow  the  user  to  trace  the 
"decisionmaking"  process  of  allocations. 
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Ordar  waapona  which  mat  tha  OE  goal  froia  lowaat  OE  to  highaat  DE;  ordar  othar  waapona  froa  highaat  OE  to  lowaat  DE 

Tha  OE  goal  la  to  ba  mt  aa  a  naan  DE  for  tha  antira  targat  objaetlva 
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WSOKTi  N««pon«  aort«d  by  rtqulctnvnts  th«y 
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for  allocation  but  tht  oe  rtqulrtAtnt  can  bt  rtlaxtd  • 

9HOCi  Stltetlnq  wtaponU)  of  Cholct*.* 

Htapon  of  Cholct  Mqulrtmtnti  N0T.9fC6H 
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229  of  d^MHin  uatd  agalnit  210  of  OHT^Rtd 
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REQOE:  Neapon(s)  meeting  the  OE  requirement  are  net  available 
for  allocation  but  the  OE  requirement  can  be  relaxed  • 

SWOC:  Selecting  Weapon(s)  of  choice... 

Weapon  of  Choice  Requirement:  NOT.SZCfiH 
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Weapons  WOC  Requirement? 
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SHOC:  Salactlng  Haaponla)  of  Cholca... 

Haapon  of  Cholca  Ragulraaant:  SILO 
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EVALCE:  Calculating  Danage  due  to  thla  Allocation 

200  ot  d_0>SH  uaad  agalnat  200  o(  NVC^Yallou 

DC  agalnat  thla  target  .101 

Updating  Inventorlea:  Neapona  ot  thla  type  left  are... 
d_0-5H  20 

RCASTl:  Current  OE:  .101 
Coal  DC:  .400 

Objective  haa  been  covered  vlth  1  vpt. 

BEGIN  HORKINC  OK  TAACET  OBJECTIVE  DU'  Violet 
Priority;  '  1 

HCOUNT:  Current  Weapon  Count  la  102 


NSOAT:  Neapona  aorted  by  requlranenta  they  neat... 


Torgot 

Nun  Mob 

Tiao 

OE 

Prl 

OEf_Violtt 

200 

F 

NT 

.900 

S 

Ot 

Hoopono 

Nua  Mob 

TIjm  Alort  Mot? 

OE 

Prl 

Allowod? 

d_D-5H 

20 

F 

TS 

d^ 

N 

.729 

6 

Y 

9"d-5H 

191 

F 

TS 

9. 

N 

.729 

13 

Y 

dja 

27 

F 

TU 

N 

.729 

2 

Y 

9'MMIIX 

lU 

F 

TU 

dZ 

N 

.792 

9 

Y 

q^MX 

121 

F 

TU 

9_ 

N 

.729 

9 

Y 
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20  M 


NT 


.<SS 


UQOEi  M**pon(»  mt*tin9  tht  OE  itqulimtnt  «t«  not  ovtllobl* 

(or  allocotlon  but  tho  OE  ttquiioiunt  can  ba  itlaxad  - 

NSEIXTi  Haapon  aalactad  for  allocation  iai  d_0>SH 

MALtOCi  Nunbar  ot  Haapona  Avallabla  (or  Allocationi  20 

eVALOEi  Calculatinq  Oanaqa  dua  to  thia  Allocation 

20  of  d_D-SH  uaad  aqalnat  200  of  OEr_Vlolat 

OE  aqalnat  thla  tacqat  .721 

Updatlnq  Invantorlaai  Naapona  of  thla  typa  laft  ara... 
d_o-JK  0 

ACASTli  Currant  OEi  .07j 
Coal  OEi  .100 

Aawrltlnq  tha  tarqat  objactlva  for  tarqata  not  yat  covarad... 

NCOVNTi  Currant  Maapon  Count  la  <02 

Haapon  (a)  Oaplatad  -  d_0'>>H 

HSOATi  Naapona  aortad  by  raqulraaanta  thay  naat... 


Tarqat 

Mum  Mob 

Tina 

oe 

frl 

0Er_vlolat 

UQ 

f 

MT 

.100 

i 

oe 

Naapona 

hum  Hob 

Tina  Alart  Hat7 

oe 

•rl  Allovadl 

q  b-SH 

IM 

r 

TS 

q_ 

N 

.T2I 

u 

T 

d~HX 

27 

r 

TU 

d_ 

M 

.721 

2 

V 

q'MHIll 

IK 

r 

TU 

ol 

M 

.702 

1 

Y 

».*« 

121 

r 

TU 

0. 

N 

.721 

9 

Y 

d  I'lEq 

20 

H 

MT 

d 

M 

7 

Y 

AEOOti  Haapon(al  aaatlnq  tha  Ot  raqulraaant  ara  not  avallabla 
for  allocation  but  tha  OE  raqulraaant  can  ba  ralaaad  • 

HtELCTi  Haapon  aalactad  for  allocation  lai  q.0«lH 

uiutci  Nuabar  of  Haapona  Avallabla  for  Allocationi  IH 

EVALOEi  Calculatinq  oaaaqa  dua  to  thla  Allocation 

1«0  of  q_o-lH  uaad  aqalnat  Uo  of  OET.vlolat 

OE  aqalnat  thla  tarqat  .72t 

Updatlnq  Invantorlaai  Naapona  of  thla  typa  laft  ara... 
q_o-SK  U 

ACASTli  Currant  OEi  .721 
Coal  DEi  .too 

Objactlva  haa  baan  covarad  with  1  «pt. 

ACAST2I  Horktnq  on  tarqat  ob)actlvai  OEr_Vlolat  of  priority  i 
Horklnq  on  lat  Paaa  Subaati  1 
Currant  OE  for  allocation  aubaati  .721 

Additional  vaapon  par  tarqat  OE  raqulrad  to  naat  Eaaa  2  Coal: 
HSORT2!  Haapona  aortad  by  taqulrananta  thay  aaati 


Tarqat 

Mum  Mob 

Tlaa 

oe 

Frl 

DEF_VloIat 

0 

r 

NT 

.900 

$ 

wopcn 

Alloc«tfd 

Mum  Mob 

Ug 

Alart 

DC 

Frl 

20 

5 

.720 

9 

DS 

TlMO 

Htipont 

mum  Mob 

Uq 

Altrt  Mot? 

oe 

Frl 

Mot? 

Allovod? 

d  MX 

2? 

r 

X 

A 

Y 

.929 

2 

Y 

Y 

oIhx 

121 

F 

X 

A 

Y 

.929 

9 

Y 

Y 

lie 

F 

X 

A 

Y 

.943 

• 

Y 

Y 

q"0-5H 

u 

F 

s 

A 

Y 

.929 

13 

Y 

Y 

d'e-lBq 

20 

M 

A 

A 

Y 

.909 

7 

Y 

Y 

NSELCT;  Haapon  aalactad  for  allocation  la:  d__HX 
NALLC2;  Haapona  aalactad  ara  d_MX 


.2M 


98 


WKCAlCi  Additional  DE  achlav«d 

by  thla  woapcni  1.57I924E-01 

iCaapona  naadad;  73 

KAtUS:  Nunbar  of  Naapona  Avallabla  for  Allocatloni  27 

Nunbar  of  Tarfata  naodln;)  Sacond  Maapon:  20 

Nunbar  of  waapona  to  ba  Allocatadi  20 

Iha  old  D*  lai  7.2l270n-01 

Tba  naw  DS  la;  7.4a0<02E-01 

NCOUNTi  Currant  Waapon  Count  la  212 

ItCAST2i  Kotlclno  on  targat  objactlvai  BEf_Vlolat  of  priority  5 
Horklno  on  lat  faaa  Subaati  2 
Currant  DE  for  allocation  aubaati  .721 

Additional  uaapon  par  targat  DE  raquitad  to  naat  Paaa  2  Coali 
MSOAT2:  Naapona  aortad  by  raqulrananta  thay  iiaati 


Tarqat 

Nun  Mob 

Tina 

OE 

rri 

DEr^Vlol*t 

0 

r 

NT 

.too 

s 

fatal  Naapon 

Allocated 

Nun  Hob 

Log 

Alert 

oe 

pci 

IIO 

s 

.721 

13 

oe 

Tin* 

Naapona 

Nun  Hob 

U9 

Alert 

Mot? 

OE 

Prl 

Mot? 

Allowod? 

d  MX 

1 

r 

I 

d_ 

Y 

.92( 

2 

Y 

Y 

121 

f 

X 

9- 

Y 

.92( 

» 

Y 

Y 

qjwiii 

11« 

r 

1 

9. 

Y 

.943 

1 

Y 

Y 

d^O-SH 

11 

r 

s 

9- 

Y 

.92( 

13 

Y 

Y 

d~8-l0d 

20 

H 

A 

d 

Y 

.90( 

7 

Y 

Y 

NseiCTi  Waapon  aalactad  for  allocation  lai  d_MX 

NALlCft  Waapona  aalactad  ara  d_NX 

WNCAlCi  Additional  DE  aehlavad 

by  tMa  waapeni  l.>7l$24t*01 

Naapona  naadadi  ii 

NAILC2]  Nunbar  of  Naapona  Avallabla  for  Allocatloni  7 

Nunbar  of  Tatoata  naadlno  Oacond  waaponi  93 

Nunbar  of  Naapona  to  ba  Allocatadi  7 

Tha  old  DE  lai  7.ai0(02E>01 

Tha  nau  DE  lai  7.J49IE4E-01 

NCOUNTi  Currant  Naapon  Count  la  27J 

Naaponlal  Daplatad  -  d_KX 

ECA9T2I  Norkind  on  tarqat  ab}actlvai  DEr_Vlolat  of  priority  i 
Norklnd  on  lat  Paaa  Subaati  3 
currant  DE  for  allocation  aubaati  ,729 

Additional  weapon  par  taryat  OE  taqulrad  to  naat  Paaa  2  Coali 
NSOAT2I  Waapona  aortad  by  raqulrananta  thay  naati 


Tarqat 

Nun  Mob 

Tlno 

oe 

Pci 

DCr_Violot 

0  F 

NT 

.100 

s 

Pastl  wo«s>on 

Allocotod 

Nun  Mob 

Ug 

Alert 

oe 

Pri 

9_D-5H 

173 

S 

9^ 

.721 

13 

oe 

Tlno 

Ntopon* 

Hun  Mob 

Ug 

Alort  Mot? 

oe 

Pri  Mot? 

Ailovod? 

9_MX 

121  r 

I 

g^ 

Y 

.929 

9  Y 

Y 

g^MMlXI 

119  r 

I 

9^ 

Y 

.943 

9  Y 

Y 

19  F 

s 

9^ 

Y 

.929 

13  Y 

Y 

d^B-lBg 

20  M 

A 

d 

Y 

.909 

7  Y 

Y 

NSELCTi  Naapon  aalactad  for  allocation  la:  q^MX 
WA1.LC2:  Naapona  aalactad  ara  q_HX 


.2«4 


.2(4 
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MNCALC:  Additional  DE  achiavtd 

by  thia  wtapon;  1.97I924E-01 

Maapona  ntadad; 

NALLC2:  Nunbar  of  Naapona  Avallabla  for  Allocation:  121 

Nunbac  of  Tar9atf  naadlng  Sacond  Waapon:  46 

Nunbar  of  Haapons  to  ba  Allocatad;  4C 

Tha  old  DE  la:  7,S494«4E-01 

Tha  naw  OE  la:  I.OOS017E-01 


WCOUNT:  Currtnt  Uttpon  Count  it 

229 

HCOUNTi  Currtnt  Ntapon  Count  it 

229 

BEGIN  TASS  2  T^ALUATION 

RCAST2:  Working  on  ttrgtt  objtctlvt: 

OMT^Rtd 

of  priority  1 

Working  on  lat  Faaa  Subaati  2 
currant  DE  for  allocation  aubaati  ,720 

Additional  waapon  par  targat  DE  raquirad  to  naat  Faaa  2  Coal: 


NSOKT2:  Haapona  aortad  by  raqulramanta  thay  naat: 


Targat 

Num 

Hob 

Tint 

OE 

Trl 

OHT^Rwd 

0 

r 

TU 

*•00 

1 

Ttttl  Wttpon 

AllocAttd 

Nun  Hob 

Ltg 

Altrt 

DE 

Prl 

d_MX 

122 

I 

d^ 

,720 

2 

oe 

Tina 

Wttpont 

Hun  Hob 

Lag 

Alart 

Htt? 

OE 

'rl 

Nat?  Allowad? 

g  0-5H 

11 

r 

s 

A 

Y 

.*11 

13 

N 

Y 

g'MMXlI 

lU 

r 

X 

A 

Y 

.*44 

• 

Y 

Y 

aIhx 

75 

r 

t 

A 

Y 

.*21 

9 

Y 

Y 

d  B^'lBg 

20 

H 

A 

A 

N 

.7** 

7 

N 

Y 

HSElCTi  Waapon  aalactad  tor  allocation  lai  g_o>SH 

WAll,C2i  Waapona  aalactad  ara  g_0'‘SH 

WNCAbCi  Additional  DE  achlavad 

by  thla  waapon:  l,9lf472E*0t 

Waapona  naadad:  SI 

WALLC2:  Nunbar  of  Naapona  Avallabla  for  Allocation:  It 

Nunbar  of  Targata  naadlng  Sacond  Waapon:  SI 

Nunbar  of  Naapona  to  ba  Allocatad:  14 

Tha  old  DE  la:  7.7142tSE-0S 

Tha  naw  OE  la:  7.llfSI4E>01 

WCOUNT:  Currant  waapon  Count  la  211 

Waapon la)  Daplatad  -  g_0-SH 

kCAST2;  Working  on  targat  objactlva:  OMT_kad  of  (,rlorlty  1 
Working  on  lat  Faaa  Subaat:  3 
Currant  OE  for  allocation  aubaat:  .720 

Additional  waapon  par  targat  OE  raquirad  to  naat  Faaa  2  Coal: 


WSOIIT2:  Naapona  aortad  by  raqulrananta  thay  naat: 


Ttrgtt 

Nun  Hob 

Tint 

DE 

frl 

OMT_Rtd 

0  r 

TU 

.900 

1 

Ttttl  Wttpon 

Alloctttd 

Nun  Hob 

Ug 

Altrt 

OE 

rri 

d_HX 

104 

X 

d_ 

a720 

2 

OE 

Tint 

Wttpont 

Nun  Hob 

Ug 

Altrt 

HttT  OE 

?ti 

Htt? 

Allovtd? 

g  MKZXX 

116  ? 

Z 

A 

Y  .944 

• 

Y 

Y 

g^HX 

75  f 

X 

A 

Y  .921 

9 

Y 

Y 

d_B-lBg 

20  H 

A 

A 

N  799 

7 

N 

Y 

NSELCT:  Waapon  aalactad  for  allocation  la:  g_MMIII 
WALIC2:  Naapona  aalactad  ara  g_HNlll 


.2t7 


.2t7 
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HNCALC:  Additional  DE  achlavad 

by  thla  wtapeni  2.241S73e*01 

y«ai/.'aa  neadadi  2S 

MALU:2;  Nunbar  of  Htapona  Avallabla  for  Alloeatloni  IK 

Nunboc  of  Targota  ntading  Stcond  Moaponi  2) 

Nunbar  of  Haapona  to  ba  Allocatadi  2* 

Tha  old  DE  lai  7.IKSI4E-01 

Tha  naw  DE  iai  l,002314E>i)l 


NCOUNTi  Currant  Naapon  Count  is  112 

ECAST2:  Coal  DE  for  targat  objactlva:  U)R_Blua  haa  baan  nat. 

ECA3T2I  Coal  DE  for  targat  objactlvai  NVC.Oranga  haa  baan  mat. 

ECAST2i  Working  on  targat  objactlvai  NUC.fallow  of  priority  4 
Working  on  lat  Paaa  Eubaati  1 
current  OE  for  allocation  aubaati  .301 

Additional  vaapon  par  targat  DE  raqulrad  to  naat  raaa  2  Coali 


W30ET2I  Waapona  aortad  by  raqulrananta  thay  maati 


Targat 

Nun  Mob 

Tina 

OC 

$ri 

NUC_Tallow 

0  r 

TS 

.100 

4 

pAisl  »;'4apon 

AUocatvd 

Nun  Mob 

lag 

Alart 

OC 

Prl 

d^O-SH 

200 

5 

.SOI 

4 

OC 

Tint 

Waapona 

Nun  Mob 

lag 

AltrC 

H«t7 

OC 

frt 

M*t7 

AllotttdT 

9.HK 

75  r 

I 

A 

Y 

.•<0 

$ 

Y 

Y 

g_««ni 

•7  r 

I 

A 

H 

,74$ 

• 

Y 

Y 

d  B-lBg 

20  M 

A 

A 

N 

.704 

7 

N 

Y 

W3BLCTI  waapon  aalactad  for  allocation  lai  g_HX 

WAIU2I  Waapona  aalactad  ata  g.MX 

WNCAICI  Additional  OE  acMavad 

by  thla  waaponi  3.S}3{4SE*01 

Waapona  naadadi  HI 

WALLC2I  Nunbar  of  Waapona  Avallabla  for  Allocation!  33 

Nunbar  of  Targata  naadlng  Eacond  Waaponi  K3 

Nunbar  of  Waapona  to  ba  Allocatadi  33 

Tha  old  DE  lai  S.010S32E-01 

Tha  naw  OE  lai  C.3SI1IIE-01 

NCOUNTi  Currant  Naapon  Count  la  103 

Naaponial  Daplatad  •  g_HX 

hCAdT2:  Working  on  targat  objactlvai  NUC^Tallow  of  priority  4 
Working  on  lat  Paaa  Subaati  2 
Currant  OE  for  allocation  aubaati  .301 

Additional  vaapon  pat  targat  OE  raqulrad  to  naat  Eaaa  2  Coal: 
NSOAT2:  Waapona  aortad  by  raqulrananta  thay  naati 


Targat 

Nun  Mob 

Tina 

OC 

Frl 

NUC_YtllOW 

0  r 

TS 

.too 

4 

Paaal  Naapon 

Allocatad 

Nun  Hob 

ug 

Alart 

OC 

Prl 

d_D-5H 

12S 

s 

d_ 

.SOI 

« 

OC 

Tint 

Waapona 

Nun  Mob 

U9 

Alart 

Mtt? 

DC 

Prl 

Mtt? 

Allovcdj 

•  7  F 

1 

A  ■ 

N 

.749 

• 

Y 

Y 

d_B-lB9 

20  M 

A 

A 

N 

.704 

7 

N 

Y 

REQ0E2:  Naaponia)  naatlng  tha  DE  raquitanant  ara  not  avallabla 
for  allocation  but  tha  DE  raquitanant  can  ba  ralaaad  - 

NSEICT:  Naapon  aalactad  for  allocation  la:  g_HHlIl 


.33* 


.333 
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HAI.LC2!  MMponi  stltctid  tr*  9_MMlt: 

NNCALCi  Additional  OE  aehiavtd 

by  thia  vaapani  2,4M024E-01' 

Haapona  naadad:  113 

NALLC2I  Nunbar  of  Naapona  Avallabla  for  Alloeatloni  17 

Numbar  of  Targata  naadlng  Eacond  Naaponi  12S 

Nunbar  of  Maapona  to  ba  Allocatadi  *7 

Tha  old  DE  lai  C.]SI1I9E>01 

Tha  naw  OE  lai  7.434740E-01 

NcoUNTi  Currant  Waapon  Count  la  20 

Naapon(a)  Daplatad  •  9_MMIII 

ACAST2I  Horklng  on  targat  objactlvai  NUC_Yallou  of  prlprlty  4 
Hocking  on  lat  Faaa  Subaati  3 
Currant  OE  for  allocation  aubaati  .301 

Additional  waapon  par  tacgat  OE  caqultad  to  naat  paaa  2  Ooali 


H30AT2I  Haapona  aortad  by  ragulraaanta  thay  naati 


Tacgat 

Nun  Mob 

Tina 

OE 

frl 

NUC.Tallov 

0  r 

T* 

.100 

4 

raaal  Haapon 

Allocatad 

NUM  Mob 

Ug 

Alact 

OE 

ftl 

d_0-3H 

31 

s 

.301 

4 

Haapona 

Nun  Mob 

Uf 

Alart 

OE 

Mot? 

OE 

rci 

Tina 

Mot?  Allovodi 

20  M 

A 

A 

N 

.704 

7 

M  t 

AEQHOBi  Haaponlal  naatlng  tha  nobility  cagulraaant  ara  not  avallabla 
for  allocation  but  tha  nobility  cagulcanant  can  ba  ralaaad  • 

REQ0C2I  Haaponlal  naatlng  tha  OE  ragulianant  ara  not  avallabla 
for  allocation  but  tha  OE. cagulcanant  can  ba  ralaaad  • 

HEELCTi  Haapon  aalaetad  for  allocation  lai  d.E'lBg 

HALIM  I  Haapona  aalaetad  ara  d_b*llg 

HHCALCi  Additional  OE  lehlavad  r 

by  thla  waaponi  2.02I740E-01 

Haapona  naadad i  3d 

HAILC2;  Nunbar  of  Haapona  Avallabla  for  Alloeatloni  20 

Nunbar  of  Targata  naadlng  Sacond  Naaponi  3t 

Nunbar  of  Haapona  to  ba  Allocatadi  20 

Tha  old  OE  lai  7.43d740E-01 

Tha  naw  OE  lai  7, 4414132-01 

HCOUNTi  Currant  Haapon  Count  la  0 

Haaponlal  Daplatad  •  d_B-lBg 


.i>» 


END  FALCON 
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Appendix  E 

CHANGING  THE  MAXIMUM  NUMBER  OF  WEAPON  TYPES, 
TARGET  OBJECTIVES,  AND/OR  ALLOCATIONS 


This  appendix  is  provided  to  assist  the  user  in  changing  the  number 
of  allowed  weapon  types,  target  objectives,  and/or  allocations  (unique 
assignments  of  weapons  to  targets)  in  FALCON. 

To  facilitate  the  explanation,  the  following  integer  variables  are 
defined.  (Note  that  these  are  not  variable  names  used  in  FALCON.) 


xW  -  The  maximum  number  of  weapon  types,  currently  60. 

If  the  user  wants  to  distinguish  between  weapons  on 
day-to-day  alert  versus  those  available  upon 
generation,  the  user  can  only  enter  xW/2  types  of 
weapons . 

xT  -  The  maximun.  number  of  target  objectives,  currently  100. 

xA  -  The  total  number  of  allocations  for  the  execution, 
currently  300. 


We  typically  use  the  following  sets  of  values  for  three  variables; 


Variable 

PC 

VAX  or  : 

xW 

60 

100 

xT 

100 

200 

xA 

300 

1000 

In  order  to  change  these  variables,  the  following  changes  should  be 

made. 


1.  Modify  the  common  blocks  as  follows: 


ALLOC . CDE : 
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INTEGER*4  ATNUM.AWTYP.WPT 

COMMON  /ALLOC/  NDXA,IC0P,INDX(xT,2) ,AWTYP(xA,3) , 

+  ATNUM(xA) ,DEA(xA,4) ,DE1 (xA) ,WPT(xA) , 

+  DEOLD(xT) ,DENEW(xT) ,ISC,IDGO(xT) ,MAXOBJ 


AWEAPS.CDE: 

CHARACTER*!  AWX(xW) 

PHARAPTFRVf?  AWTTA  xWl 

COMMON  /AWEAPS/  NSALL,ICONT,IDXSA(xW) ,IUSE(2) ,NWA(2) , 

+  .  ISM0BC2),ISTIM(2,3),ISALT(2,3,2),ISDE(2,3,2,2) 

COMMON  /AWEAPC/  AWX.AWT 


FDNAM.CDE: 

No  changes  necessary. 


OBJ.CDE: 

CHARACTER*!  MDR(xT) 

CHARACTER*3  ANDOR(xT) 

CHARACTER* 12  W0C(xT,2) 

CHARACTER*80  RUNNAM 
INTEGER*4  OPR.TGOFOR 

COMMON  /OBJ/  N0BJ,IC0,0PR(xT),0DEl(xT),0DE2(xT),TG0F0R(xT) 
COMMON  /OBJC/  woe, ANDOR, RUNNAM, MDR 


PDES . CDE : 

COMMON  /PRDES  /  SDE(xT,4,2) ,NOHIT!(xT) ,N0HIT2(xT) 


PRIO.CDE: 

COMMON  /PRIO/  NIP,IPRIO(xT) 


PRINT. CDE: 

No  changes  necessary. 


RULES. CDE: 


No  changes  necessary. 
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SSPKDE . CDE : 


COMMON  /SSPKDE/  D£(xT,xW) 


TAROT. CDE: 

CHAR.4CTER*!  MOBT(xT)  ,.VNTK2(  'T)  ,VNTK3(xT) 

CHARACTER*12  TOBJ(xT) 

I NTEGER*4  TNUM , TOR , VNTK 1 , VNTK3 , HOB 

COMMON  /TAROT/  TNUM(xT) ,PDET(xT) ,TUR(xT) ,R95(xT) ,AZMTH(xT) , 
+  OFF(xT),VNTKl(xT),HOB(xT),DMIN(xT) 

COMMON  /TARGTC/  TOBJ,MOBT,VNTK2,VNTK3 


WEAPS . CDE : 


CHARACTER* 10  WNAM 
CHARACTER*4  WCAT 
CHARACTER*!  MOBW.WLEG 
I NTEGER*4  A I NV , WTU , WPR , YLD , CEP , WPMAX 

COMMON  /WEAPS/NWTYP,WPR(xW) ,WTU(xW) ,NW(xW) ,WAV(xW) ,NWTH(xW) , 

+  PWTH(xW) ,WAG(xW) ,WAD(xW) ,PLSS(xW,4) ,RELL(xW) , 

+  RELI(xW) ,RELW(xW) ,PTPS(xW.4) ,YLD(xW) ,CEP(xW) , 

+  PLS(xW) ,PTP(xW) ,AINV(xW) ,AINVAL(xW) ,AINVWL(xW) , 

+  AINVRL(xW) ,AINVNS(xW) ,AINVT(xW) ,NMAX, WPMAX 

COMMON  /WEAPSC/  WNAM(xW) .WCAT(xW) ,WLEG(xW) ,MOBW(xW) 


2.  Modify  these  subroutines: 


1.  In  SETDEF.FOR  -- 

line  36:  MA.XOBJ  =  xA 

line  37:  NMAX  =  xW 

2.  In  KEADOD.FOR  -- 

line  73:  IF(J.GT.xT)  THEN 

I'ne  75:  WRITE(15,*)  '  target  types.  Max  of  xT  allowed.' 

line  78:  WRITE(*,*)  '  target  types.  Max  of  xT  allowed.' 


3.  Modify  the  DIMENSION  statements  of  the  following  subroutines. 
Generally,  these  are  local  work  arrays  that  temporarily  store 
targets,  weapons,  or  allocations  data.  The  numbers  in  brackets 
give  the  approximate  line  numbers. 


OBPRIO.FOR  [14] 


DIME.NSION  X(xT) 


105 


PDCALC.FOR 

[16] 

DIMENSION  H0BW(xT,xW) 

ROUT23.FOR 

[16] 

DIMENSION  PSAVE(xW,4) 

RP0UT3.F0R 

[21] 

DIMENSION  PSAVE(xW,4) 

SSPKT.FOR 

[25] 

DIMENSION  SSPKKxT.xW) 

WINVNT.FOR 

[14] 

DIMENSION  INVAL(xW) ,INVWL(xW) ,INVNS(xW) ,INVRL(xW) 

WRHOB.FOR 

[20] 

DIMENSION  H0BW(xT,xW) 

WSORTA.FOR 

[22] 

DIMENSION  IWORK(xW) 

WSORTD.FOR 

[23] 

DIMENSION  IWORK(xW) 

WSORTL.FOR 

[22] 

DIMENSION  IWORK(xW) 

WSORTM.FOR 

[18] 

DIMENSION  IWORK(xW) 

WSORTP.FOR 

[18] 

DIMENSION  IWORK(xW) 

WSORTT.FOR 

[22] 

DIMENSION  IWORK(xW) 

WSPDE2.F0R 

[23] 

DIMENSION  IWORK(xW) 

WSPRDE.FOR 

(22] 

DIMENSION  IWORK(xW) 

WSRTA2.F0R 

[25] 

DIMENSION  IWORK(xW) 

WSRTD2.F0R 

[25] 

DIMENSION  IWORK(xW) 

WSRTT2.F0R 

[18] 

DIMENSION  IWORK(xW) 

Modify  in  the  CHARACTER  statements  of  the  following  subroutines. 

Again,  these  are  local  work  arrays  that  temporarily  store  targets, 
weapons,  or  allocations  data.  The  numbers  in  brackets  give  the 
approximate  line  numbers. 

SSPKT.FOR 

[22] 

[23] 

CHARACTER*12  TSSPK(xT) 

CHARACTER*10  WSSPK(xW) ,WNAM2 

3W0C . FOR 

[17] 

CHARACTER* 1  CLEG , AWW ( xW ) 

WRHOB.FOR 

[11] 

CHARACTER* 1 1  WNAM2 ( xW ) , WTEMP , WTEMP2 

WRSSPK.FOR 

[  9] 

CHARACTER* 1 1  WNAM2 ( xW ) , WTEMP , WTEMP2 

WS0RT2 . FOR 

[29] 

CHARACTER*!  ATIM(xW) 
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WSORTA.FOR 

[12] 

CHARACTER*! 

IWX(xW) 

WSORTD.FOR 

[14] 

CHARACTER*! 

IWX(xW) 

WSORTL.FOR 

[12] 

CHARACTER*! 

IWX(xW) 

WSORTP.FOR 

(10] 

CHARACTER*! 

IWX(xW) 

WSORTT.FOR 

[13] 

CHARACTER*! 

IWX(xW) 

WSPDE2.F0R 

[13] 

CHARACTER*! 

IWX(xW) 

WSPRDE.FOR 

[13] 

CHARACTER*! 

IWX(xW) 

WSRTA2.F0R 

[14] 

CHARACTER*! 

IWX(xW) 

WSRTD2.FOR 

[IS] 

CHARACTER*! 

IWX(xW) 

WSRTT2.F0R 

(  9] 

CHARACTER*! 

IWX(xW) 

After  all  of  the  above  changes  have  been  made,  all  subroutines 
should  be  re-compiled  and  re-linked  before  execution  is  initiated. 
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Appendix  F 
SOURCE  CODE 


This  appendix  provides  the  source  code  for  all  FALCON  subroutines. 
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SUBROUTINE  ABUMP(II) 

c 

C  ABUMP  bumps  (or  shifts)  values  in  the  ALLOC  arrays  to  a-llow  room- for 
C  additional  array  entries.  A  zeroed  element  is  added  after  the  II 
C  element  and  all  subsequent  elements  are  bumped  up  by  1. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE;  'OB.T  CDE' 

C 

NDXA  =  NDXA  +  1 
IF(NDXA.GT.MAXOBJ)  THEN 

WRITE(15,*)  'ABUMP:  Number  of  Allocations  exceeds  number', 

+  '  allowed.' 

WRITE (15,*)  '  FALCON  stopping. ' 

WRITE(*,*)  'ABUMP:  Number  of  Allocations  exceeds  number', 

+  '  allowed.' 

WRITE(*,*)  '  FALCON  stopping. ' 

STOP 

ENDIF 

C 

C  Bump  all  the  Il+l  thru  NDXA  elements  up  by  1... 

DO  100  II  =  II, NDXA- 1 

I  =  NDXA  +  II  -  II 
J  =  I  +  1 
DO  103  K  =  1,3 

103  AWTYP(J,K)  =  AWTYP(I,K) 

— ■  DO  lOA  K  =  1,4 

104  DEA(J,K)  =  DEA(I.K) 

ATNUM(J)  =  ATNUM(I) 

DEI(J)  =  DEI(I) 

WPT(J)  =  WPT(I) 

100  CONTINUE 
C 

C  Zero  out  the  new  Il+l  elements... 

DO  203  K  =  1,3 

203  AWTYP(I1+1,K)  =  0 
DO  204  K  =  1,4 

204  DEA(I1+1,K)  =  0 
ATNUM(I1+1)  =  0 
DEI(I1+1)  =  0 
WPT(I1+1)  =  0 

C 

C  Update  the  IDGO  array,  used  by  EVALDE... 

IB  =  INDX(IC0P,1) 

IE  =  INDX(IC0P,2) 

IF(IB.NE.O)  THEN 

DO  300  I  =  II, IE-1 
J  =  IE  +  II  -  I  - 
K  =  J+1 


IB  +  1 
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300  IDGO(K)  =  IDGO(J) 

ENDIF 

C 

C  Set  the  new  indeces . . . 

IF(INDX(ICOP,1).EQ.O)  INDX(IC0P,1)  =  Il+l 
IF(INDX(ICOP,2).EQ.O)  THEN 
INDX(ICOP,2)  =  INDX(ICOP,l) 

ELSE 

INDX(IC0P,2)  =  INDX(ICOP,2)  +  1 
ENDIF 
C 

DO  110  I  =  IC0P+1,N0BJ 
DO  110  K  =  1,2 

110  IF(INDX(I,K).NE.O)  INDX(I,K)  =  INDX(I,K)  +  1 
C 

1000  RETURN 
C 

END 


o  o  o  o 
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SUBROUTINE  DNCALC 


Calculates  the  total  DE  for  the  current  objective  after  the 
reallocation  of  weapons  to  targets. 


IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'TARGT.CDE' 

C 

K  =  ICO 
DETOT  =  0. 

IB  =  INDXdCOP.l) 

IE  =  INDX(IC0P,2) 

IF(IB.NE.O)  THEN 
DO  100  I  =  IB. IE 

C  Discount  any  first  weapons  of  a  pair... 

IF(WPT(I).EQ.-1)  GOTO  100 
DETOT  =  DETOT  +  DEA(I ,ISC)*ATNUM(I) 

100  CONTINUE 
ENDIF 
C 

DENEW(K)  =  0. 

IF(TNUM(K).NE.O)  DENEW(K)  =  DETOT/TNUM(K) 
C 

RETURN 

C 

END 
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c 

C**' 


SUBROUTINE  ERRMS4(IERR,IV,JT,KF,YLD,CEP,H0B1,R95,D,WR,P0D, 
A  IFLG,AZMTH,LU) 


ViVVfVfVfiVjVAVfVfVfAVfiWfVfVriVVfVfVfVf**!';*******^';*!'?*****?'?***********^’^'?*********** 


C 

C  THE  ERROR  MESSAGE  ROUTINE  IS  CALLED  TO  PRINT  AN  ERROR  MESSAGE  WHEN 

C  AN  ERROR  OCCURS  IN  PDCALC  AND  THE  IFLG  VALUE  IS  LESS  THAN  100. 

C 

C  CALLED  FROM;  MAIN 

C  SUBROUTINES  CALLED:  NONE 

C  ERROR  FLAGS  SET:  NONE 

C 

DIMENSION  KFCHAR(IO) 

C  CHANGED  BY  SDG  FOR  IBM  COMPATIBILITY 

C  DATA  KFCHAR  / 'O' , ' 1 ' , '2' , '3' , '4’ , '5 ' , '6' , ' 7 ' , '8' , '9 ' / 

DATA  KFCHAR  /1H0,1H1.1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/ 

C 

C  CONVERT  K  FACTOR  TO  A  CHARACTER  VALUE  IF  A  NUMERIC  VALUE  WAS 

C  PASSED  IN 

IF  (KF  .LT.  0  .OR.  KF  .GT.  9)  GO  TO  2 
I  =  KF  +  1 

CSDG  DON'T  CHANGE  KF  INTO  A  CHARACTER  -  DEFINE  A  KFX  INSTEAD 
KFX  =  KFCHAR(I) 

2  CONTINUE 
C 

WRITE  ( LU . 4 )  I ERR , I V , JT , KFX , YLD , HOB 1 , R9 5 , CEP , D , WR , POD , IFLG , AZMTH 
4  FORMAT  (/,'  PDCALC  ERROR  NUMBER  ',12,'.  INPUTS  WERE  :  ',/, 

A  '  VNTK;  ',I2.A1.A1,'  YLD: ’ ,F10. 1 , '  HOB: ' ,F10.2, '  R95:',F6  2, 

B  '  CEP:',F8.2,'  D:',F8.2,'  WR:',F10.0,'  POD:  ',F4.3, 

C  '  IFLG:  ',14,'  AZMTH: ' ,F7.2) 

C 

C  lERR  OF  15  IS  A  WARNING  MESSAGE  —  NOT  AN  ERROR 
IF  (lERR  .EQ.  15)  GO  TO  6 
C 

IF  ((IFLG. EQ. 5). OR. (IFLG. EQ. 6))  D  =  .0 

IF  ((IFLG. NE. 9). AND. (IFLG. NE. 10))  WR  =  .0 

IF  ((IFLG. NE. 5). AND. (IFLG. NE. 6))  POD  =  .0 

C 

6  GOTO  (10, 20, 30, 40, 50, 60, 70, 80, 90, 100, no, 120, 130, 140, 150), lERR 
C 

10  WRITE  (LU,11) 

11  FORMAT  ('  YOU  CANNOT  ACHIEVE  DESIRED  POD  WITH  THIS  WEAPON',/) 
RETURN 

C 

20  WRITE  (LU,21) 

21  FORMATC  VN  (IV)  IS  TOO  LARGE  TO  USE  FOR  AVAILABLE  DATA  CURVES',/) 
RETURN 

C 

30  WRITE  (LU,31) 

31  FORMAT  ('  SHOB  GREATER  THAN  900  FEET  -  TOO  LARGE  FOR  AVAILABLE  DAT 
lA  CURVES',/) 
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40 

41 


C 

50 

51 


60 

61 


C 

70 

71 


C 

80 

81 


90 

91 


C 

100 

101 


C 

110 

111 


C 

120 

121 


C 

130 

131 


C 

140 

141 


RETURN 

WRITE  (LU,41) 

FORMAT  ('  THE  ONLY  OPTIONS  AVAILABLE  W/  ETA  TGTS  ARE  IFLG=1  OR  2. 
A.  YOUR  IFLG  CONTAINS  SOME  OTHER  VALUE.’,/) 

RETURN 

WRITE  (LU,51) 

FORMAT  ('  T  OF  VNTK  MUST  BE  AN  I  WHEN  IFLG  =  7',/) 

RETURN 

WRITE  (LU,61) 

FORMAT ('  K  FOR  THIS  T^YPE  OF  VNTK  MUST  BE  0-9*,/) 

RETURN 

WRITE  (LU,71) 

FORMAT  ('  K  FACTOR  FOR  PHYSICAL  VULNERABILITY  DATA  SHEET  MUST', 

A'  1  OR  2',/) 

RETURN 

WRITE  (LU,81) 

FORMAT  ('  K  OF  PERSONNEL  VNTK  MUST  BE  1-9  OR  A-P',/) 

RETURN 

WRITE  (LU,91) 

FORMAT  ('  T  OF  VNTK  IS  NOT  A  VALID  CHARACTER',/) 

RETURN 

WRITE  (LU.lOl) 

FORMAT  ('  CRATER  REQUIRED  BY  VNTK  (T  =  X,Y,Z,W,V  OR  H) .  HOB  MUST 
IBE  LESSS  THAN  .99  FEET’,/) 

RETURN 

WRITE  (LU.lll) 

FORMAT  ('  K  OF  VNTK  MUST  SPECIFY  A  FATALITY  CURVE  ', 

A  'FOR  "IFLG=7  '",/) 

RETURN 

WRITE  (LU,121) 

FORMAT  ('  SHOB  GREATER  THAN  1000  FT  -  TOO  LARGE  FOR  AVAILABLE  DAT 
lA  CURVES' ,/) 

RETURN 

WRITE  (LU,131) 

FORMAT  ('  ILLEGAL  IFLG.  VALUE  MUST  BE  1-11  OR  101-111  ',/) 

RETURN 

WRITE  (LU,141) 

FORMAT  ('  NO  DATA  FOR  PHYSICAL  VULNERABILITY  DATA  SHEET  SPECi', 

A  'FIED  BY  THE  VN  NUMBER' ,/) 

RETURN 
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C 

150 

151 


WRITE  (LU,151)  IV 

FORMAT  ('  PDCALC  WARNING  -  DATA  CALCULATED  IS  FOR  SEVERE  DAMAGE', 
A  '  VNTK.  MODERATE  DAMAGE  FOR  PV  DATA  SHEET  ',12,'  IS  NOT  ', 

B  'DEFINED.',/) 

RETURN 


C 


END 
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SUBROUTINE  EVALDE 

C 

C  EVALDE  evaluates  the  damage  due  to  the  current  allocation 
C  of  weapons  against  the  current  target  objective,  updates 
C  the  weapon  inventories  and  condenses  the  list  of  available 
C  weapons,  where  necessary. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

§ INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  ' ALLOC. CDE’ 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PRINT. CDE’ 

$ INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

I F ( I PR INT . NE . 0 . AND . OPR ( ICO ) . GE . TP 1 . AND . OPR ( I CO ) . LE . TP2 )  THEN 
WRITE (15,*) 

WRITE(15,*)  'EVALDE:  Calculating  Damage  due  to  this  ', 

+  'Allocation' 

ENDIF 

C 

C  Do  the  calulations  for  a  single  weapon... 

IF  (IUSE(2).EQ.O)  THEN 
NDXA  =  NDXA  +  1 

IF(INDX(ICOP,1).EQ.O)  INDX(IC0P,1)  =  NDXA 
INDX(IC0P,2)  =  NDXA 
IF(NDXA.GT.MAXOBJ)  THEN 

WRITE(15,*)  'EVALDE:  Number  of  Allocations  for  Pass  l', 
+  '  exceeds  number  allowed.' 

WRITE(15,*)  '  FALCON  stopping. ' 

WRITE(*,*)  'EVALDE:  Number  of  Allocations  for  Pass  1  ', 
+  'exceeds  number  allowed.  ' 

WRITEC*,*)  '  FALCON  stopping. ' 

STOP 

ENDIF 

ATNUM(NDXA)  =  NWA(l) 

AWTYF(NDXA,1)  =  lUSE(l) 

AWTYP(NDXA,2)  =  0 
AWTYP(NDXA,3)  =  ICO 
DEA(NDXA,ISC)  =  DE(IC0,IUSE(1)) 

CALL  SCNDE 1 ( NDXA , DE A (NDXA , I SC ) , I USE ( 1 ) ) 

WPT(NDXA)  =  1 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2) 

+  THEN 

WRITEdS,*)  '  '  ,ATNUM(NDXA), 

+  '  of  ' ,WNAM(AWTYP(NDXA,1)),’  used  against  ', 

+  TGOFOR(ICO),'  of  ',T0BJ(IC0) 

WRITE (15 ,3000)  '  DE  against  this  target:  ', 


ENDIF 


DEA(NDXA,ISC) 


C  Otherwise  do  pairs... 

DO  100  1=1,2 

IF(IUSE(1).EQ.IUSE(2).AND.I.EQ.2)  GOTO  100 
NDXA  =  NDXA  +  1 

IF(INDX(IC0P,1).EQ.0)  INDX(IC0P,1)  =  NDXA 
INDX(IC0P,2)  =  NDXA 
IF(NDXA.GT.MAXOBJ)  THEN 

WRITE(15,*)  'EVALDE:  Number  of  Allocations  for  Pass  1 
+  '  exceeds  number  allowed. ' 

WRITEdS,*)  '  FALCON  stopping.  ’ 

WRITEC*,*)  'EVALDE:  Number  of  Allocations  for  Pass  1 
+  'exceeds  number  allowed.  * 

WRITE (*,*)  '  FALCON  stopping. * 

STOP 

ENDIF 

ATNUM(NDXA)  =  NWA(I) 

AWTYP(NDXA,1)  =  lUSE(I) 

WPT(NDXA)  =  -1*1 

IF(IUSE(1).EQ.IUSE(2))  WPT(NDXA)  =  2 

DEA (NDXA, ISC)  =  0 

CALL  SCNDE1(NDXA,0.,IUSB(1)) 

100  CONTINUE 


Save  the  DE  for  the  pair... 

DEA(NDXA,ISC)  =  l.-(l.-DE(ICO,IUSE(l)))* 
(l.-DE(ICO,IUSE(2))) 

CALL  SCNDE2 (NDXA , DE ( ICO , lUSE ( 1 ) ) , lUSE ( 1 ) , 
DE(IC0,IUSE(2)),IUSE(2)) 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2) 

THEN 

IF(WPT(NDXA).EQ.2)  THEN 
WRITE (15, 30 15)  ATNUM(NDXA) , '  pairs  of  ', 
WNAM(AWTyP(NDXA,l)),'  used  against  ', 

TGOFOR(ICO),'  of  ’.TOBJdCO) 

WRITE (15 ,3020)  '  Combined  DE  against  this  ', 

'target:  ', DEA (NDXA, ISC) 

ELSE 

WRITE(15,3010)  ATNUM(NDXA-l), '  of  ' , 

WNAM(AWTYr (NDXA- 1,1)),’  and  ' ,ATNUM(NDXA) , 

'  of  ',WNAN(AWTYP(NDXA,1)).'  used  against  ', 
TGOFOR(ICO),’  of  ’.TOBJdCO) 

WRITE(15,3020)  '  Combined  DE  against  this  ', 

'target:  ', DEA (NDXA, ISC) 

ENDIF 

ENDIF 
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ENDIF 

C 

C  Update  the  inventories . . . 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2) 

+  WRITE(15,*)  '  Updating  Inventories:  Weapons  of 

+  'this  type  left  are...' 

DO  300  1=1,2 

IF(IUSE(I).EQ.O)  GO  TO  300 
AINVdUSEd))  =  AINVCIUSEd))  *  NWAd) 

I F (I PR I NT . NE . 0 . AND . OPR (I CO ) . GE . TP 1 . AND . OPR (I CO ) . LE . TP2 ) 

+  WRITECIS,*)  '  '.WNAMdUSEd)),'  ', AINVCIUSEd)) 

300  CONTINUE 
C 

C  Save  the  partial  &  total  DEs  for  this  objective... 

DETOT  =  0. 

IB  =  INDXCICOP.l) 

IE  =  INDXdC0P,2) 

IFCIB.NE.O)  THEN 
DO  350  I=IB,IE 

C  Discount  the  first  weapon  of  a  pair. . . 

IF(WPTd).EQ.-l)  GOTO  350 

DETOT  =  DETOT  +  ATNUMd)*DEAd ,  ISC) 

DEId)  =  DETOT/TNUMCICO) 

350  CONTINUE 
ENDIF 
C 

3000  F0RMAT(A31,1X,F5.3) 

3010  FORMAT(6X.IA,AA,A10,A5.I4,A4,A10,A14,I4,A4,A12) 

3015  FORNAT(6X,I4,A10,A10,A14,I4,A4,A12) 

3020  FORMAT(A35.A8,F4.3) 

C 

RETURN 

C 

END 
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PROGRAM  FALCON 

c 

C  The  main  program  of  the  strategic  Force  ALloCatiON  model.  It 
C  governs  all  program  operations  through  reading  of  input  data, 

C  initialization,  calculation  of  weapon  inventories,  determination 
C  of  suitable  weapons  for  allocation,  allocation  of  weapons, 

C  and  evaluation  of  damage. 

C 

C  FALCON  was  designed  by  :  James  Scouras 
C  The  RAND  Corporation 

C  2100  M  St.,  NV 

C  Washington,  DC  20037 

C  (202)  296-5000 

C  FALCON  was  written  and  developed  by: 

C  Mary  Nissen 

C  Nissen  Research  and  Engineering 

C  Ease  309  1^‘th  Avenue,  #206B 

C  Spokane,  WA  99202 

C  (509)  838-1553 

C 

C  Date  this  version;  August  1990 
C 

IMPLICIT  INTEGER*4(I-N) 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'AWEAPS.CDE' 

$  INCLUDE:  'FDNAM.CDE' 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'PRIO.CDE' 

$ INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'TARGT.CDE' 

C 

WRITE (*,*)  'begin  FALCON  2.0' 

WRITE(*,*)  'Enter  the  name  of  the  output  file  for  Results:  ' 

WRITE(»' ,*)  '  (max  8  characters  plus  3-character  extent)  ' 

READ (*,3000)  OFNAME 
0PEN(16,FILE=0FNAME) 

WRITE(*,*)  'Enter  the  name  of  the  output  file  for  Diagnostics:  ' 
WRITE(*,*)  '  (max  8  characters  plus  3-character  extent)  ' 
REAI.(*,3000)  AFNAME 
0PEN(15,FILE=AFNAME) 

IF(I>’RINT.NE.O)  WRITE(15,*)  'BEGIN  FALCON  2.0' 

C 

C  Read  all  the  input  and  do  the  required  initializations  and 
C  preprocessing.  The  input  data  will  be  stored  in  arrays... 

CALL  READID 
C 

C  Calculate  all  weapon  inventories  -  this  accounts  for  the  availabilities 
C  and  lo. ses  input  for  the  weapons,  taking  out  any  specified  withold... 
WRITE (*,*)  'CALCULATING  WEAPON  INVENTORIES' 


o  o 
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CALL  WINVNT 
C 

C  Set  up  the  SSPK  table  and  use  it  to  create  the  weapon-target 
C  vulnerability  table. 

WRITEC*,*)  'CALCULATING  SSPK  VALUES' 

CALL  SSPKT 
CALL  WCOUNT(NWEAP) 

IF(NWEAP.LE.O)  GOTO  800 
C 

NDXA  =  0 
IPASS  =  1 

WRITEC*,*)  'BEGIN  PASS  1  EVALUATION' 

IF(IPRINT.NE.O)  THEN 
WRITE (15,*) 

WRITE (15,*)  'BEGIN  PASS  1  EVALUATION' 

END  IF 
C 

DO  200  I  =  1,N0BJ 
ICO  =  IPRIO(I) 

I COP  =  I 

INDX(IC0P,1)  =  0 
INDX(ICOP,2)  =  0 

WRITEC*,*)  'BEGIN  WORKING  ON  TARGET  OBJECTIVE  ',TOBJ(ICO) 
IF(IPRINT.NE.O)  THEN 
WRITE (15,*) 

WRITE(15,*)  'BEGIN  WORKING  ON  TARGET  OBJECTIVE  ',TOBJ(ICO) 
WRITE(15,*)  '  Priority:  ' ,OPR(ICO) 

ENDIF 

C 

C  If  this  target  has  a  first  pass  DE  goal  of  zero,  skip  to  the  next 
C  target  objective... 

IF(ODE1(ICO).EQ.O)  THEN 

C  If  the  second  Pass  DE  goal  is  not  zero,  check  whether  MDR  is  set... 

IF(ODE2(ICO).NE.O)  GOTO  210 
IF(IPRINT.NE.O)  THEN 
WRITEC 15,*) 

WRITE (15,*)  '  This  objective  has  a  zero  DE  goal  -' 

WRITE(15,*)  '  Returning  to  work  on  next  objective.' 

ENDIF 
GOTO  200 
ENDIF 
C 

C  Count  the  available  weapons... 

250  CALL  WCOUNT(NWEAP) 

IF(NW'EAP.LE.O)  GOTO  800 


Sort  the  weapons . . . 

CALL  WSORT 
C 

C  Check  the  WOC  requirement... 
CALL  REQWOC 


UO  OOU  OOO  OCJO  u  oo 
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GOTO(210,500,600)  ICONT+1 
C 

C  Select  a  weapon... 

500  CALL  WSELCT 

GOTO(210,600,600)  ICONT+1 
C 

C  Continue  with  the  allocation... 

600  CALL  WALLOC(IRCAST) 

Evaluate  the  DE,  update  the  status  of  targets  and  weapons... 

CALL  EVALDE 

Write  another  'goal'  at  this  priority  level  to  account  for 
untargeted  targets,  if  necessary... 

CALL  RCASTl(IRCAST) 

If  objective  has  been  recast  and  there  are  weapons  left, 
continue  to  work  on  this  objective... 

IF(IRCAST.NE.O)  GOTO  250 

For  objectives  requiring  the  DE  (IDE  or  MDE)  be  met  before  proceeding  to 
lower  priority  objectives,  do  Pass  2  for  this  objective  now... 

210  CONTINUE 

IF(MDR(IC0).EQ. '*')  CALL  RCAST2(IC0) 

200  CONTINUE 

Do  the  Pass  2  Evaluation... 

700  IF(IPASS2.EQ. '1')  GOTO  800 
CALL  WCOUNT(NWEAP) 

IF(NWEAP.LE.O)  GOTO  800 
IPASS  =  2 

WRITE (*,*)  'BEGIN  PASS  2  EVALUATION' 

IF(IPRINT.NE.O)  THEN 
WRITE(15,*) 

WRITE (15,*)  'BEGIN  PASS  2  EVALUATION' 

END  IF 
IMDR  =  0 

CALL  RCAST2(IMDR) 

800  CALL  RPOUT 

WRITE!*,*)  'END  FALCON  ' 

IF(IPRINT.NE.O)  THEN 
WRITE (15,*) 

WRITE (15,*)  'END  FALCON  ' 

ENDIF 
C 

CLOSE (15) 

CL0SE(16) 

C 

3000  F0RMAT(A12) 
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C 

C 


STOP 

END 
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SUBROUTINE  OBPRIO 

C 

C  Establish  priorities  for  the  objectives.  The  result  are  the  values 
C  NIP,  the  highest  priority  of  any  objectives  and  IPRIO,  the  array 
C  of  objectives  in  priority  order,  both  stored  in  /PRIO/. 

C 

IMPLICIT  INTEGER*A  (I-N) 

C 

$ INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' PRINT. CDE' 

$ INCLUDE:  'PRIO. CDE' 

$ INCLUDE:  'TARGT.CDE' 

C 

DIMENSION  X(IOO) 

C 

NIP  =  0 
C 

C  Fill  the  X  and  IPRIO  arrays  before  sorting. . . 

DO  100  J=1,N0BJ 

IF(OPR(J).GT.NIP)  NIP  =  OPR(J) 

X(J)  =  OPR(J) 

IPRIO(J)  =  J 
100  CONTINUE 
C 

C  Sort  from  greatest  priority  to  least,  using  a 
C  bubble  sort. . . 

DO  200  J=l,N0BJ-l 
DO  200  K=J+l,NOBJ 

IF(X(K).GT.X(J))  GO  TO  200 
TEMP  =  X(K) 

TEMP2  =  IPRIO(K) 

X(K)  =  X(J) 

IPRIO(K)  =  IPRIO(J) 

X(J)  =  TEMP 
IPRIO(J)  =  TEMP2 
200  CONTINUE 
C 

250  IF  (IPRINT.EQ.2)  THEN 
WRITEdS,*) 

WRITE(15,*)  'OBPRIO:  Prioritizing  Objectives: ' 

WRITE(15,*)  '  Objective  Priority' 

WRITEdS,*)  '  . ' 

DO  300  12  =  l.NOBJ 

WRITEdS, 2000)  TOBJdPRIOd2)),OPRdPRIOd2)) 

300  CONTINUE 
END  IF 

2000  F0RMAT(9X,A12,6X,I3) 

C 

1000  RETURN 
C 


END 
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SUBROUTINE  PDCALC 
C 

C  PDCALC  sets  up  the  calls  to  PDCLCA  for  each 
C  weapon  in  combination  with  each  target  objective. . . 
C 


IMPLICIT  INTEGERS  (I-N) 

C 

CHARACTER*!  IUP(26) , ID0WN(26) 
$ INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' PRINT. CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 


C 


C 

C 

C 


C 


DIMENSION  H0BW(100,60) 


DATA  lUP  /'A'.'B'.'C'.'D' 
1  'N','0','P','Q' 

DATA  IDOWN/'a','b','c','d' 
1  •»'  »-• 


’E',’F','G','H','I' 

'R',’S','T’,'U','V' 

’e','f','g','h','i' 

'r','s','t','u','v' 


,'J','K','L','M', 

.'W','X','Y','Z'/ 

.’J'.'k'.'l'.'m'. 

.’w'.'x'.'y'.'z'/ 


Set  flags,  IETA=0  for  non-ETA  target,  IFLG=2  for 
calculation  of  SSPK  (up  to  value  of  .999)... 
lETA  =  0 
IFLG  =  2 


DO  50  I  =  1,N0BJ 

C  Prepare  the  VNTK:  convert  to  upper  case,  flag  if  ETA  target... 
IV  =  VNTKl(I) 

JT  =  VNTK2(I) 

DO  52  152  =1,26 

IF(JT.EQ.ID0WN(I52))  JT  =  IUP(I52) 

52  CONTINUE 

C  Disallow  't'  value  of  G,  J  or  K... 

IFCJT.EQ. 'G' .OR.JT.EQ. 'J' .OR.JT.EQ. 'K' )  THEN 
WRITE (*,*) 

WRITE(*,3000)  'Illegal  T  value  of  VNTK:  ',VNTK1(I), 

+  VNTK2(I),VNTK3(I) 

WRITE(*,3010)  'Target  Objective  was:  ',T0BJ(I) 

WRITEC*,*)  'FALCON  Stopping.' 

WRITEdS,*) 

WRITE(15,3000)  'illegal  T  value  of  VNTK:  ',VNTK1(I), 

+  VNTK2(I),VNTK3(I) 

WRITEdS, 3010)  'Target  Objective  was:  '.TOBJd) 
WRITECIS,*)  'FALCON  Stopping. ' 

STOP 

ENDIF 

KFX  =  VNTK3(I) 

DO  100  K  =  1,6 

IFCJT.EQ. lUP(K))  lETA  =  1 
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100  CONTINUE 

C  Prepare  the  R95  value:  for  ETA  targets,  get  the  orientation  and 
C  azimuth. . . 

IF(IETA.EQ.l)  THEN 
R95NM  =  R95(I) 

AZM  =  AZMTH(I) 

ELSE 

AZM  =  0. 

R95NM  =  R95(I) 

ENDIF 

C  Prepare  the  Offset  (nm) . . . 

OFFNM  =  OFF(I) 

DO  55  J=1,NWTYP 

C  Prepare  yield  (kt)  and  CEP(ft)... 

YLDKT  =  YLD(J) 

CEPFT  =  CEP(J) 

C 

C  Prepare  the  HOB:  find  the  optimum  HOB  if  selected... 
IF(H0B(I).NE.-1)  THEN 
HOBI  =  HOB (I) 

ELSE 

HOBI  =  -1 

CALL  PDEXEC (I V,JT,KFX, YLDKT, HOB I, R95NM, CEPFT, OFFNM, 

+  DUMY,DUMY,IFLG,IERR,AZM) 

ENDIF 

C 

HOBWd.J)  =  HOBI 

IFdSSPK.EQ. '5' .AND.DE(I,J).NE.O)  GOTO  55 
C 

CALL  PDCLCA (I V , JT , KFX , YLDKT , HOBI , R95NM , CEPFT , OFFNM , 

+  DUMY,DEd,J),IFLG,IERR,AZM) 

IFdERR.NE.0.AND.IERR.NE.2.AND.dERR.LT.4.0R.IERR.GT.9) 

+  .AND. IERR.NE.il. AND. lERR.NE. 14)  THEN 

LU  =  6 

CALL  ERRMS4 (I ERR , I V , JT , KFX , YLDKT , CEPFT , HOB I , R9 5NM , 

+  DMY,DMY,DMY,IFLG,AZM,LU) 

IFdPRINT.GE.2)  THEN 
LU  =  15 

CALL  ERRMS4 (lERR , I V , JT , KFX , YLDKT , CEPFT , HOB I , R95NM , 

+  DMY,DMY,DMY,IFLG,AZM,LU) 

ENDIF 
PAUSE 
ENDIF 
55  CONTINUE 
C 

IFdERR.NE.0.AND.IERR.EQ.2.OR.  dERR.GE.4.AND.  IERR.LE.9) 

+  .0R.IERR.EQ.11.0R.IERR.EQ.14)  THEN 

LU  =  6 

CALL  ERRMS4 (lERR , I V , JT , KFX , YLDKT , CEPFT , HOB I , R95NM , 

+  DMY,DMY,DMY,IFLG,AZM,LU) 

IFdPRINT.GE.2)  THEN 
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LU  =  15 

CALL  ERRMS4 ( lERR . I V , JT , KFX , YLDKT , CEPFT , HOB I , R9  5NM , 
+  DMY,DMY,DMY,IFLG,AZM,LU) 

ENPIF 
PAUSE 
ENDIF 
50  CONTINUE 
C 

IF(IPRINT.NE.O)  CALL  WRHOB(15,HOBW) 

C 

3000  F0RMAT(1X,A25,I2,A1,A1) 

3010  F0RMAT(1X,A22,A12) 

C 

RETURN 

C 

END 
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SUBROUTINE  PDCLC4(IV,JT,KF,YLD,H0B1,R95,CEP,D,WR,P0D, 
A  IFLG,IERR,AZMTH) 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PDCLC4  IS  A  SUBROUTINE  IN  FORTRAN  4  WHICH  CALCULATES  THE  AVERAGE 
PROBABILITY  OF  ACHIEVING  AT  LEAST  THE  LEVEL  OF  DAMAGE, 
SPECIFIED  BY  A  VULNERABILITY  NUMBER,  TO  AN  INSTALLATION 
USING  A  SPECIFIC  WEAPON  TARGETTED  AGAINST  AN  EXPLICIT 
DGZ  LOCATION.  OPTIONAL  CALCULATIONS  ARE  AVAILABLE  THROUGH 
IFLG  CONTROL.  PDCLC3  IS  BASED  ON  DIA  PUBLICATION 
AP-550-1-2-69-INT,  1  JUNE  1969,  "PHYSICAL  VULNERABILITY 
HANDBOOK  -  NUCLEAR  WEAPONS  (U),"  CHANGE  4  (1  JUNE  1984). 


THE  SUBROUTINE  ARGUMENTS  HAVE  THE  FOLLOWING  MEANINGS: 

IV  =  AN  INTEGER  NUMBER  DESCRIBING  TARGET  HARDNESS  OR 
TARGET  DIMENSIONS  (ETA).  INDICATES  VULNERABILITY 
NUMBER  (VN  OF  VNTK). 

JT  =  'T'  PORTION  OF  VNTK.  CAN  BE  1,  2,  OR  3  IN  ADDITION 
TO  ALPHABETICS  DEFINED  IN  TDI  HANDBOOK. 

KF  =  'K'  PORTION  OF  VNTK  WHICH  IS  NORMALLY  AN  INTEGER  NUMBER 
FROM  0  TO  9.  FOR  P  AND  Q  TYPE  TARGETS  THIS  DENOTES 
TARGET  RESPONSE  TO  SHOCK  DURATION.  FOR  POPULATION  EF¬ 
FECTS  IT  DENOTES  THE  DOMINANT  STRUCTURE  IN  THE  AREA, 

AND  CAN  BE  AN  ALPHABETIC  A  THRU  P. 

YLD  =  YIELD  OF  WEAPON  IN  KILOTONS 
HOBl  =  ACTUAL  HEIGHT  OF  BURST  OF  THE  WEAPON  IN  FEET. 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 


R95  =  RADIUS  IN  NAUTICAL  MILES  (TO  THE  NEAREST  ONE-TENTH) 

OF  A  CIRCLE  ENCOMPASSING  95  PERCENT  OF  THE  CIRCULAR 
NORMAL  TARGET  AREA. 

FOR  ETA  TARGETS,  R95*10  =  ORIENTATION  OF  THE  TARGET 
IN  DEGREES. 

CEP  =  CIRCULAR  ERROR  PROBABLE  OF  THE  SPECIFIED  WEAPON  SYSTEM 
IN  FEET. 

D  =  DISTANCE  IN  NAUTICAL  MILES  FROM  DGZ  TO  TARGET. 

WR  =  WEAPON  RADIUS  IN  FEET. 

POD  =  PROBABILITY  OF  ACHIEVLNG  THE  SPECIFIED  LEVEL  OF  DAMAGE 
AGAINST  THE  GIVEN  TARGET  WITH  THE  GIVEN  WEAPON. 

IFLG  =  THERE  ARE  DIFFERENT  RESULTS  THAT  PDCALC  CAN  PRODUCE. 
THE  OUTPUT  CREATED  IS  CONTROLLED  BY  GIVING  IFLG  THE 


o  o  o 
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C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 


FOLLOWING  VALUES: 

1  =  PRODUCE  POD  UP  TO  VALUE  OF  .990.  D  MUST  BE  INPUT. 

CLN  FUNCTION  IS  USED. 

2  =  PRODUCE  POD  UP  TO  VALUE  OF  .999.  D  MUST  BE  INPUT. 

CLN  FUNCTION  IS  USED. 

3  =  SEE  4. 

4  =  PRODUCE  WEAPON  RADIUS. 

5  =  SEE  6. 

6  =  PRODUCE  D,  THE  MAXIMUM  DISTANCE  AT  WHICH  A  GIVEN  POD 

CAN  BE  ACHIEVED.  POD  MUST  BE  INPUT.  (LNCALC  USED) 

7  =  PRODUCE  FATALITY  POD  AND  CASUALTY  POD.  ' 

THESE  VALUES  ARE  RETURNED  IN  POD  AND  WR 
VARIABLES,  RESPECTIVELY.  D  MUST  BE  INPUT. 

8  =  DAMAGE  SIGMA  IS  INPUT  THROUGH  POD  VARIABLE.  POD  IS 

OUTPUT.  (D  IS  INPUT) 

9  =  DAMAGE  SIGMA  AND  WEAPON  RADIUS  ARE  INPUT.  POD  IS 

OUTPUT.  (D  IS  INPUT) 

10  =  WR  INPUT.  POD  IS  OUTPUT.  (D  IS  INPUT) 

11  =  DAMAGE  SIGMA  IS  RETURNED  FROM  THE  DDSIG  TABLE. 

AZMTH  =  AZIMUTH  IN  DEGREES  FROM  DGZ  TO  TARGET. 


C  lERR  =  IS  A  FLAG  USED  TO  NOTIFY  THE  CALLING  PROGRAM  OF  ERRORS 
C  THAT  MIGHT  HAVE  OCCURRED  IN  PDCALC.  THE  USER  MAY  SUPPRESS 
C  THE  PRINT  OF  ERROR  MESSAGES  (ON  FORTRAN  UNIT  6)  BY  ADDING 
C  100  TO  THE  IFLG  VALUE  IN  THE  CALL  TO  PDCALC. 

C  *iV*iVVfVf******iVA*VfiV*AiVi'n'fiV*****iV**!5r»V*A***5V*>V*********>ViV*;V*iV*-.V******AA 


C 


C  THIS  IS  THE  PDCALC  MAIN  DRIVER.  IT  READS  THE  INPUT  VALIDITY 
C  CHECKS  SOME  OF  THE  VALUES,  AND  BRANCHES  TO  THE  APPROPRIATE 
C  ROUTINE  FOR  DAMAGE  CALCULATIONS. 

C  SUBROUTINES  CALLED:  ERROR  FLAGS  SET: 

C  WRCAL4  PVDS4 

C  LNCAL4  ETCALA  0  4  5  9  10  11  13 


C  WRPER4  ERRMS4 

Q  *V  «V'^)V«V«V^V«V«V)V«V7V)V«V^ 

DIMENSION  DDSIG(23),JTD(23),JJTD(23),KFN(27),KFI(27),ISUPRS(15) 
C  NEXT  LINE  CHANGED  BY  WLC  ON  6-10-86  AS  PER  SUN  MEMO  14  MAR  86 
COLD  DATA  JTD  / 'R' , 'S ' , 'Q' , 'T' , 'U' , 'L' , 'P' , 'M' , 'N' , 'O' , 

COLD  1  'X','Y','Z','W','V','A','B','C','D’,'E','F','I','H'/ 

CHANGED  BY  SDG  FOR  IBM  COMPATIBILITY 

DATA  JTD  /'R','S','Q','T’,'U','L’,’P','M’,'N','0', 

1  'Y','X','Z','W',’V','A’,'B',’C'.'D','E',’F',’I','H'/ 

CPRIME  FOR  MULTIC  AND  CRAY  (LOWERCASE  ADD  NEXT  LINE 
C  MUST  CHANGE  NEXT  TO  UPPER  CASE 

DATA  JTD  /1HR,1HS,1HQ,1HT,1HU,1HL,1HP,1HM,1HN,1H0, 

1  IHY , IHX , IHZ .  m' , IHV , IHA , IHB . IHC , IHD , IHE , IHF , IHI , IHH/ 

DATA  JJTD  /  5*2,  5*1,  5*0,  5,  6,  7,  8,  9,  10,  3,  4  / 

DATA  DDSIG  /  . 1 , . 2 , . 3, .4 , .5 , . 1 , . 2 , . 3 , .4 , . 5 , . 1 , . 2 , . 3 , . 4, . 5 , 

1  7*1.,. 3  / 


oooo  oooo  oo  CJC3  ran  ooocaooo 
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TABLE  KFN  CONTAINS  POSSIBLE  NUMERIC  LITERALS  (EBCDIC)  FOR  KF  THAT 
NEED  TO  BE  CONVERTED  INTO  INTEGER 
CHANGED  BY  SDG  FOR  IBM  COMPATIBILITY 

DATA  KFN  / ’O' , ' l' , *2’ , '3' , '4' , *5 ' , '6' , '7 ' , '8 ' , '9 ' , 'A' , ’B' , 'C , 

1  'D’,'E','F',’G','H','I’,'J','K’,'L','M','N','0’,'P','Q'/ 

PRIME  FOR  MULTIC  AND  CRAY  (LOWERCASE  ADD  NEXT  LINE 
MUST  CHANGE  NEXT  TO  UPPER  CASE 

DATA  KFN  /1H0,1H1,1H2,1H3,1H4.1H5,1H6,1H7,1H8,1H9,1HA,1HB,1HC, 

1  IHD , IHE , IHF , IHG , IHH , IHI , IH J , IHK , IHL , IHM , IHN , IHO , IHP , IHQ/ 

DATA  KFI  /  0,1,2.3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,10,11,12,13,14, 

1  15,16,17  / 


WRSAVE  =  WR 
DO  10  M=l,23 

IF(JT.EQ.JTD(M))  GO  TO  20 
10  CONTINUE 


JT  IS  NOT  A  VALID  ALPHA  CHARACTER 
lERR  =  9 
GO  TO  900 
20  JJT  =  JJTD(M) 

DSIG  =  DDSIG(M) 

CONVERT  KF  TO  INTEGER  IF  IT  IS  NUMERIC  LITERAL  (EBCDIC) 

KFI  =  KF 

IF  (KFI  .GE.  0  .AND.  KFI  .LE.  9)  GO  TO  40 
DO  30  1=1,27 

IF  (KFI  .NE.  KFN(I))  GO  TO  30 
KFI  =  KFI (I) 

GO  TO  40 
30  CONTINUE 
40  lERR  =  0 

DECODE  IFLG  VALUE,  DETERMINE  WHETHER  OR  NOT  TO  SUPPRESS  ERROR 
MESSAGE  PRINT.  IF  IFLG  >  100,  SUPPRESS  THE  ERROR  MESSAGES 

lERRCL  =  1 
IFLGl  =  IFLG 

IF  (IFLGl  .LT.  100  )  GO  TO  50 
IFLGl  =  IFLGl  -  100 
lERRCL  =  0 

50  IF  (IFLGl  .EQ.  3)  IFLGl  =  4 
IF  (IFLGl  .EQ.  5)  IFLGl  =  6 
IF  (IFLGl  .GT.  0  .AND.  IFLGl  .LE.  11)  GO  TO  70 
lERR  =  13 
GO  TO  900 


DETERMINE  THE  TARGET  TYPE  AND  BRANCH  TO  THE  APPROPRIATE  AREA. 
JJT  TARGET  TYPE  (VNTK  'T'  FACTOR) 


o  o  o  o  o 
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C  —  . 

C  0  CRATER  TARGET  (X,Y,Z,W,V)  SAME  METHODOLOGY  AS  'P'  TYPE 

C  1  OVERPRESSURE  SENSITIVE  (L,P,M,N,0)  'P'  TYPE 

C  2  DYNAMIC  PRESSURE  SENSITIVE  (R,S,Q,T,U)  'q'  TYPE 

C  3  PERSONNEL  (I) 

C  4  PHYSICAL  VULNERABILITY  DATA  SHEET  (H) 

C  5-10  ETA  TARGET  (A,B ,C,D,E,F)  DAMS,  LOCKS,  BRIDGES 

C*V?*VfVr***Vf*Vf****'!V*Vf**-.V*Vf*VfVf**VfV.-VnV*V{Vr*Vf*iV*Vr*Vf'>'fVf****Vr*iV*>V*****Vf*iV*Vf*i'f**Vf** 

c 

70  CONTINUE 

IF  (IFLGl  .NE.  11)  GO  TO  80 

Q?V')V***Vf*VfVf*Vf**iV*Vf*V.'******Vf*VfVfVf***>V**Vf*iV***VfVfVr***>'f5V****>V5V*iV**iV*iViV**iV*VfAA 

IF  (JJT  .EQ.  2) 

A  CALL  WRCAL4(YLD,H0B1, IV, JJT, KF1,DSIG,WR, IFLGl, lERR) 


AZMTH  =  DSIG 
RETURN 

C*******  iflG  of  7  MUST  HAVE  AN  PERSONNEL  VNTK  (T-FACTOR  OF  'l' )***** 
80  IF  (IFLGl  .EQ.  7  .AND.  JJT  .NE.  3)  GO  TO  90 
IF  (JJT  .LE.  2)  GO  TO  100 
IF  (JJT  .EQ.  3)  GO  TO  300 
IF  (JJT  .EQ.  4)  GO  TO  400 
IF  (JJT  .GE.  5  .AND.  JJT  .LE.  10)  GO  TO  500 
C 

90  lERR  =  5 
GO  TO  900 


CRATER,  OVERPRESSURE,  DYNAMIC  PRESSURE  METHODOLOGY 


100  IF  (JJT  .NE.  0  .0R.(H0B1  .LT.  .99  .AND.  HOBl  .GE.  0.))G0  TO  110 
lERR  =  10 
GO  TO  900 

110  IF  (JJT  .EQ.  0)  JJT  =  1 

IF  (IFLGl  .EQ.  8  .OR.  IFLGl  .EQ.  9)  DSIG  =  POD 
IF  (IFLGl  .GE.  9)  GO  TO  120 

^  ^  V? « V*V  * V  V*  I V  V*  V?  *  V  *  W?  V*  Vt  V*  ^ W*  Vf  *Wt  V*  V?  «V  V*  V»  V*  •  W*  ^ V  *Wr  V*  (V  * V  (V  % V  f V  «V  (W» « W?  «V  ? V  *  V  )V  «V  ^ V  «V  ^ W?  Vp  «V  «Wr  «V 

CALL  WRCAL4 ( YLD , HOB  1 , 1 V , J JT , KF 1 , DS I G , WR , I FLG 1 , 1 ERR ) 

Q^V)V)V<VV»  «V«V«V  «V«V)VV»  Vp<V<V4V^«VfV«V*V«V*VV«  «V«V*V«'P*VVr'sV>VVpV*('p  V?***  tV**?  «V'sV«V^V)V4V«V«VV» 


IF  (lERR.NE.O)  GO  TO  900 
IF  (IFLG1.NE.4)  GO  TO  120 
POD  =  0. 


RETURN 

120  CALL  LNCAL4  (CEP,  DSIG,  WR,  R95,  POD,  D,  IFLGl,  lERR) 

IF  (lERR  .NE.  0)  GO  TO  900 
RETURN 


C 

C 
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C  PERSONNEL  VULNERABILTY  METHODOLOGY 

C . 

c 

300  IFLG2  =  2 

IF  (IFLGl  .NE.  7)  GO  TO  310 
KK  =  KFl/2*2 
IF  (KFl.NE.KK)  GO  TO  310 
lERR  =  11 
GO  TO  900 

310  CALL  WRPER4(YLD,H0B1,IV,JJT,KF1,DSIG,WR,IERR) 

C**i'riVVf*iVVf*Vf***Vf**Vf**Vf***VfiV*Vf****iV")V*VtiVVnV***iV******Vr*V(r*Vf****************iV 

IF  (lERR.NE.O)  GO  TO  900 
IF  (IFLG1.EQ.4)  RETURN 

C*VfVf.V*****‘.V**iV*Vf**Vf*iV>'f*AiV*iV**iV*****i’fA****VrVriV-.V*Vf****iV*Vfi’nVVfVf*»V*iV*VfVf*****Vr 

CALL  LNCAL4  (CEP,  DSIG,  WR,  R95,  POD,  D,  IFLG2,  lERR) 

IF  (lERR.NE.O)  GO  TO  900 
IF  (IFLG1.NE.7)  RETURN 
IF  ((KF1/2*2).EQ.KF1)  GO  TO  320 
PI  =  POD 
KFl  =  KFl  +  1 
GO  TO  310 
320  WR=POD 
P0D=P1 
RETURN 
C 

C . 

C  PHYSICAL  VULNERABILITY  DATA  SHEET  METHODOLOGY 

C . 

c 

^  V»  V»  Vf  «V  < W»  «V  *  V  ^ Vp  *  W» « W? « Wf  ^ Wf  V»  «W»  ?V  ^VVf « V  •W?  ♦Wf  Vf  ^  fW?  < V»V » V  ^Wf  V?  ^ V  ^ Wf  vV  ^ V  VfVf  rf  iV 'J V  ^ V  «v 

400  CALL  PVDS4(IV, KFl, YLD,H0B1, DSIG, WR, IFLGl, lERR) 

"VpVp'Wt  »W?V?  *V*V?V  «V*W?iW??V*WpV?  «V  *W?V?V?  #W»  V?A»V»V  •WpVpVp  «Wr  fV^V  tV  fV  f'p^VVp  AVp  fV^V^V  Vp^V  •VVpVp^VVpVp^V^V 

c 

Q**5'f***-,V*-.V***?'.****VfVrVf*Vs****'!'f**V;*Vs*>V****Vr***-.V'.V-.'f.‘f*5'rvV**5V‘.V5V***Vr?V*5ViV**5'f**A*A 

CSDG  IN  CALL  TO  ERRMS4  CHANGED  WRSAVE  TO  WR 

CMJN  Added  LU  to  following  calling  sequence  to  direct  output 

C  of  error  messages.  For  this  case,  set  LU=6. 

LU  =  6 

IF  (lERR  .EQ.  15  .AND.  lERRCL  .EQ.  1)  CALL  ERRMS4 
A  (IERR,IV,JT,KF,YLD,CEP.H0B1.R95,D,WR, POD,  IFLGl  ,A7.MTH,LU) 

IF  (lERR  .NE.  0  .AND.  lERR  .NE.  15)  GO  TO  900 
IF  (IFLGl  .NE.  4)  GO  TO  410 
POD  =  0. 

RETURN 

('*  r?  V?V?  «V«V«VV?  V?  VpVp  V?  »» ’WplVV?  V?**?  <'?Vp  «*?V?  «*?^V?‘5W?V?  <V  •V 

410  CALL  LNCAL4  (CEP,  DSIG,  WR,  R95 ,  POD,  D,  IFLGl,  lERR) 

IF  (lERR  .NE.  0  .AND.  lERR  .NE.  15)  GO  TO  900 


RETURN 


C  EQUIVALENT  TARGET  AREA  (ETA)  METODOLOGY 

C . 

c 

C  CHECK  FOR  VALID  IFLG  TO  USE  ETA 
500  IF  (IFLG1.LE.2)  GO  JO  510 
lERR  =  4 
GO  TO  900 

510  JTS  =  JJT  -  4 

C*Vf*Vc**VfiV*Vf*****iViV******Vf?V*iV***iVVf*Vf>V***iV***iViV*Vf*iVA***>VVf*****>V**5'fiVVfVf*Vri!rVf 

CALL  ETCAL4  (IV, JTS.KFl ,YLD,CEP,H0B1 ,R95 ,AZMTH,D,POD,WR, lERR) 

C***>V**iV***Vf****Vf*iV****iVA*VnV*iV*VrA*iViV>VVnV*A***Vf*iV*AVf******iV**iV***>V***VfiV*Vr 

IF  (lERR.NE.O)  GO  TO  900 
RETURN 


PDCALC  ERROR  PROCESSING 


900  IF  (lERRCL  .EQ.  0)  GO  TO  910 

CAAAAVfVfA>'rAVfAAVf*iVAAAVfAAAVfAAAAAAAAAAAAAVrAAiVAAAAAA**AAAAAAAAAAAAVfAAAAAAAAA 

CSDG  IN  CALL  TO  ERRMS4  CHANGED  WRSAVE  TO  WR 

CMJN  Added  LU  to  following  calling  sequence  to  direct  output 

C  of  error  messages.  For  this  case,  set  LU=6. 

LU  =  6 

CALL  ERRMS4  (IERR,IV,JT,KF,YLD,CEP,H0B1,R95,D,WR,P0D, 

A  IFLG1,AZMTH,LU) 

CAA*AAAAAAAAAVrAAAA*A**VfAAAAAAAAAAAAA*AAAAAA*AAAAAAAAAAAA?lr*AAAAAAAAAAAAA 

RETURN 

C 

910  IF  ((IFLG1.EQ.5).0R.(IFLG1.EQ.6))  D  =  .0 

IF  ((IFLG1.NE.9).AND.(IFLG1.NE.10))  WR  =  .0 

920  IF  ((IFLGl.NE.5).AND.(IFLGl.NE.6))  POD  =  .0 

RETURN 
END 

c 

SUBROUTINE  WRCAL4  (YLD,  HOBl,  IV,  JJT,  KF,  DSIG,  WR,  IFLG,  lERR) 


c 

c 

C  WRCAL4  IS  THE  SUBROUTINE  WHICH  CALCULATES  WEAPON  RADIUS  USING  THE 
C  7TH  ORDER  POLYNOMIAL  COEFFICIENTS  IN  THE  DATA  STATEMENTS  BELOW. 

C 

C  CALLED  FROM:  MAIN 

C  SUBROUTINES  CALLED:  NONE 

C  ERROR  FLAGS  SET:  2  6  12 

C 


o  o  o 
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DIMENSION  WP(8,18),WQ(8,13) 

DIMENSION  WP1(72),  WP73(72),  WQ1(72) ,WQ73(32) 

DIMENSION  QSIG(13,32) 

DIMENSION  QSG1(195),QSG196(221) 

DIMENSION  TAVNP (18), TAVNQ ( 1 3 ) , TSHOBP ( 1 8 ) , TSHOBQ ( 13 ) 
EQUIVALENCE  (WP(1,1),  WPl(l)),  (WP(1,10),  WP73(1)) 
EQUIVALENCE  (WQ(1,1),  WQl(l)),  (WQ(1,10),  WQ73(1)) 
EQUIVALENCE  (QSIG(1 , 1) ,QSG1(1)) .  (QSIG(1,16) ,QSG196(1)) 

C 

ARRAY  WP  CONTAINS  THE  VALUES  FOR  THE  7TH  ORDER  POLYNOMIAL 
APPROXIMATION  FOR  WR  COMPUTATIONS  FOR  P-TYPE  TARGETS 
AO  A1  A2  A3 

C  A4  AS  A6  A7 

C 

DATA  WPl  / 

C  SHOE  0  AVN  56-81 

1  2.218A403E+03,-2.038A393E+02.  7 . 7871809E+00, -1 .5791337E-01 , 

1  1.7921431E-03,-1.0791711E-05,  2.6937624E-08,  O.OOOOOOOE-00, 

C  SHOE  0  AVN  0-56 

2  8.4179382E+00,-1.39S9558E-01,  8.8874034E-04,  1.1557732E-04, 

2  -6.S171236E-06,  1.5734555E-07,-1.8676597E-09,  8.852S577E-12, 

C  SHOE  20  AVN  0-56 

3  8.4160310E+00,-1.3813430E-01,  8.0858875E-04,  1 . 1427499E-04, 

3  -6.2927942E-06,  1.4873461E-07,-1.7160814E-09,  7 .8715866E-12, 

C  SHOE  40  AVN  0-56 

4  8.4180053E+00,-1.3961422E-01,  1 .5111330E-03,  3.0401988E-05 , 

4  -2.0087108E-06,  3.9934521E-08,-3.5144936E-10,  1. 1769646E-12, 

C  SHOE  60  AVN  0-56 

5  8.4211949E+00,-1.4202190E-01,  2.6598384E-03,-l .2677356E-04, 

5  7.5497819E-06,-2.5450718E-07,  4 . 1500872E-09 , -2 . 5841146E-11 , 

C  SHOE  80  AVN  0-53 

6  8.4197832E+00,-1.3563252E-01,  1 . 1721849E-03 ,  1 . 6556857E-05 , 

6  8.2651528E-07,-1.0230794E-07,  2 . 7109759E-09 , -2 . 2855071E-11 , 
C  SHOE  100  AVN  0-50 

7  8.4220240E+00,-1.3292575E-01,  5 . 7368186E-04,  8 . 1226392E-05 , 

7  -2.9712949E-06,  8 . 7281946E-09 ,  1 . 2926994E-09 , -1 . 7542970E-11 , 

C  SHOE  150  AVN  0-44 

8  8.4293786E+00,-1.2330468E-01,-2.2974151E-03,  4 . 602869 lE-04 , 

8  -2.7993967E-05,  8.2785321E-07,-l. 1068193E-08,  4. 7149273E-11 , 

C  SHOE  200  AVN  0-39 

9  8.4413856E+00,-l,1560827E-01,-5.0750819E-03,  9 . 1014643E-04, 
9  -6.358S183E-05,  2.2044664E“06,-3.558392SE-08,  2.0069297E-10/ 

DATA  WP73  / 

C  SHOE  250  AVN  0-35 

0  8.4601291E+00,-1.2040847E-01.-2.2218012E-03,  3 . 7792663E-04 , 

0  -1.7089906E-05,  6.2849153E-08,  1 . 4857856E-08 , -2 . 8212514E-10 , 
C  SHOE  300  AVN  0-31 

1  8.4754194E+00,-1.0937908E-01,-7.3913453E-03,  1 . 3609095E-03 , 

1  -1.0568408E-04,  4.0196970E'-06,-6.8227444E-08,  3.4506826E-10, 

C  SHOE  400  AVN  0-26 

2  8.5159454E+00,-1.1143596E-01,-5.4504395E-03,  9.4122080E-04, 


O  O  O  U  CJ  o 
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2  -6.2141343E-05,  1 .5174377E-06;  1.0523437E-08,-7.5193318E-10, 

C  SHOE  500  AVN  0-23 

3  8.S569860E+00,-1.0972237E-01,-6.7923668E-03,  1.4664351E-03, 

3  -1.4673425E-04,  8.0009579E-06,-2.2030310E-07,  2. 1593173E-09, 

C  SHOE  600  AVN  0-20 

4  8.5973073E+00,-1.0471815E-01,-1.2002061E-02,  3.2875424E-03, 

4  -4.3312089E-04,  3.0708138E-05,-1.0989039E-06,  1.4974601E-08, 

C  SHOE  700  AVN  0-17 

5  8.6370475E+00,-1.1089467E-01,-6.9620463E-03,  1.5757880E-03, 

5  -1.S484446E-04,  7.9600450E-06,-1.9285094E-07,  2.8938727E-10, 

C  SHOE  800  AVN  0-16 

6  8.6743792E+00,-1.13133S5E-01,-6.5949126E-03,  1.7651464E-03, 

6  -2.4400379E-04,  2. 1765577E-05,-l . 1223631E-06,  2. 1846853E-08, 

C  SHOE  900  AVN  0-14 

7  8.7092355E+00,-1.1397120E-01,-8.0841576E-03,  2 . 6655422E-03 , 

7  -4.6153006E-04,  4.8096946E-05,-2. 7690109E-06,  6. 1358427E-08, 
C  SHOE  1000  AVN  0-13 

8  8.7415762E+00,-1.1614030E-01,-6.7527100E-03,  1 . 8639925E-03 , 

8  -2.5295514E-04,  2.2554333E-05,-1.4888147E-06,  4.0146349E-08/ 

ARRAY  WQ  CONTAINS  THE  VALUES  FOR  THE  7TH  ORDER  POLYNOMIAL 
APPROXIMATION  FOR  WR  COMPUTATIONS  FOR  Q-TYPE  TARGETS 
AO  A1  A2  A3 

A4  A5  A6  A7 

DATA  WQl  / 

C  SHOE  0  AVN  0-31 

1  8.5683018E+00,-1.1510151E-01,-6.6364862E-03,  7 .2839394E-04, 

1  -2.3600397E-05,-8.4432731E-08,  1.8096256E-08,-2.5411405E-10, 

C  SHOE  50  AVN  0-31 

2  8.5116824E+00,-1.0856551E-01,-2.0629193E-03,-2.7238797E-04, 

2  6.1467099E-05,-3.7033619E-06,  9 . 5251501E-08, -9 . 1279440E-10 , 
C  SHOE  100  AVN  0-31 

3  8.4972379E+00,-1.0866530E-01,  1 .8464289E-04,-7 .0132541E-04, 

3  9.8338051E-05,-5.4160834E-06,  1 . 3724567E-07 , -1 . 3387035E-09 , 

C  SHOE  150  AVN  0-29 

4  8.4992043E+00,-1.0947870E-01,  4. 2027552E-04 , -7 . 3553498E-04 , 

4  1.0483617E-04,-6.0487282E-06,  1 .6313776E-07,-l. 7154270E-09, 

C  SHOE  200  AVN  0-26 

5  8.5103129E+00,-l.lli0023E-01,  5 . 2417582E-05 , -6 . 1716155E-04 , 

5  9.7602539E-05,-6.1707540E-06,  1 . G386975E-07 , -2 . 1613502E-09 , 

C  SHOE  300  AVN  0-22 

6  8 . 5448195E+00 , -1 . 1378886E-01 , -7 . 6733464E-04 , -2 . 6232760E-04 , 

6  5.9616371E-05,-4.6826100E-06,  1 . 7332408E-07 , -2 . 5849008E-09 , 

C  SHOE  400  AVN  0-20 

7  8.5823836E+00,-1.1398686E-01,-1.5108814E-03,  1 . 1706741E-04 , 

7  2.0986961E-06,-7.6070167E-07,  4 . 9900467E-08 , -1 . 2606168E-09 , 

C  SHOE  500  AVN  0-18 

8  8.6177199E+00,-1.1344578E-01,-1.4956039E-03,  2 . 4153006E-04 , 

8  -2.6966891E-05,  1 . 9060892E-06, -5 . 8805631E-08,  1.8404569E-10, 

C  SHOE  600  AVN  0-16 


O  O  CJ  u  o  o 
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9  8.6515113E+00,-1.124l013E-01,-1.4792271E>03 

9  -5.9007318E-05,  5.6407188E-06,-2.5394592E”07 
DATA  WQ73  / 

C  SHOE  700  AVN  0-14 

0  8.6837151E+00,-1.1149938E-01,-1.0799724E-03 

0  -4.3658280E-05,  4.9214399E-06,-2.6356030E-07 
C  SHOE  800  AVN  0-12 

1  8.7142384E+00,-1.1028039E-01,-1.2589773E-03 

1  -9.5934929E-0S,  1.2624932E-05,-8. 1212801E-07 

C  SHOE  900  AVN  0-11 

2  8.7431825E+00,-1.0959267E-01,-4.4135161E-04 

2  2.1081549E-05,-1.9568679E-06,  0. OOOOOOOE+00 

C  SHOE  1000  AVN  0-9 

3  8 . 7705694E+00 , -1 . 0844576E-01 , -8 . 3636006E-04 
3  -9.8394610E-06,-1.3492662E-06,  0. OOOOOOOE+00 

DAMAGE  SIGMAS  FOR  THE  Q'S 

STORED  FOR  32  VNS  EETIVEEN  0  AND  31 
AT  SCALED  HOES  SHOWN 

DATA  QSGl/ 

C  COLUMNS  SHOE  ROWS  Q  AVN 


0 

50 

100 

150 

200 

300 

400 

500 

600 

0 

.35, 

.31, 

.30, 

.30, 

.31, 

.32, 

.32, 

.32, 

.32, 

1 

.36, 

.32, 

.31, 

.31. 

.32, 

.33, 

.33, 

.32, 

.32. 

2 

.37, 

.33, 

.32, 

.32. 

.33, 

.33, 

.33, 

.33, 

.32, 

3 

.38, 

.34, 

.33, 

.33, 

.33, 

.34. 

.33, 

.33, 

.32, 

4 

.38, 

.35, 

.34, 

.34, 

.34. 

.34, 

.34, 

.33, 

.33, 

5 

09 

.36, 

.35, 

.35. 

.34, 

.34, 

.34, 

.33, 

.33. 

6 

.37, 

.36. 

.35. 

.35, 

.35. 

;34, 

.33, 

.33, 

.33, 

7 

.36, 

.36, 

.35, 

.35. 

.34. 

.34, 

.33, 

.33, 

.33, 

8 

.35, 

.35, 

.35. 

.34, 

.34, 

.33, 

.33, 

.33, 

.33, 

9 

.34, 

.34, 

.34, 

.34, 

.33, 

.33, 

.33, 

.33, 

.33. 

0 

.32, 

.33, 

.33, 

.33, 

.33, 

.32, 

.33, 

.33, 

.34. 

1 

.31, 

.32, 

.32, 

.32, 

.32, 

.32. 

.32. 

.33, 

.35, 

2 

.30, 

.31, 

.31, 

.31, 

.31, 

.32, 

.32. 

.34. 

.38. 

3 

.29, 

.29, 

.30, 

.30, 

.30, 

.31, 

.32. 

.35, 

.43. 

4 

.28, 

.29, 

.29, 

.29, 

.30, 

.31, 

.33, 

.39, 

.50. 

DATA  QSGl 96  / 

0 

50 

100 

150 

200 

300 

400 

500 

600 

5 

.28, 

.28, 

.28, 

.28. 

.29, 

.31, 

.35, 

.44, 

.58, 

6 

.28, 

07 

.27, 

OG 

•  y 

.29, 

.31, 

.38, 

.52, 

.  68 , 

7 

.27, 

.27, 

.27, 

.28, 

.29, 

.33. 

.43, 

.60, 

1.0, 

8 

.27, 

.27, 

.27, 

.28, 

.28, 

.35, 

.51, 

.70, 

1.0, 

9 

.27, 

.26, 

.26, 

.27, 

.28, 

.40. 

.59. 

1.0, 

1.0, 

0 

.27, 

.26, 

.26, 

.27, 

.29, 

.46. 

.68, 

1.0, 

1.0, 

1 

.27, 

.26, 

.26, 

.27, 

.30, 

.55, 

1.0, 

1.0, 

1.0, 

2 

.27, 

.26, 

.26, 

.27, 

.34, 

.  64 , 

1.0. 

1.0, 

1.0, 

3 

.27. 

.26, 

.26, 

.28, 

.39, 

1.0, 

1.0, 

1.0, 

1.0, 

4 

.27, 

.26, 

.26, 

.30, 

.46, 

1.0, 

1.0, 

1.0, 

1.0, 

3.4909168E-04, 

3.6620433E-09/ 


2.2999230E-04, 

4.0804823E-09, 

3.9539600E-04, 

1.7934666E-08, 

-6.9078548E-05, 

O.OOOOOOOE+00, 

1.0307509E-04, 

O.OOOOOOOE+00/ 


700  800  900  1000 

.31,  .31,  .31,  .30, 
.32,  .32,  .31,  .31, 
.32,  .32,  .31,  .31, 
.32,  .32,  .32,  .32, 
.32,  .32,  .32,  .34, 
.32,  .32,  .33,  .37, 
.32,  .33,  .34,  .41, 
.33,  .34,  .37,  .48, 
.33,  .36,  .42,  .57, 
.35,  .39,  .49,  .66, 
.38,  .45,  .58,  3.0, 
.42,  .53,  .67.  1.0, 
.49,  .62,  1.0,  1.0, 
.58,  1.0,  1.0,  1.0, 
.67,  1.0,  1.0,  1.0/ 

700  800  900  1000 

1.0,  1.0,  1.0,  1.0, 
1.0,  1.0,  1.0,  1.0, 
1.0,  1.0,  1.0,  1.0, 
1.0,  1.0,  1.0,  1.0, 
1.0,  1.0,  1.0,  1.0, 
1.0,  1.0,  1.0,  1.0, 
1.0,  1  0,  1.0,  1.0, 
1.0,  1.0,  1.0,  1.0, 
1.0,  1.0,  1.0,  1.0, 
1.0,  1.0,  1.0,  1.0, 


o  o  o  o  o  o 
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5 

.27, 

.26, 

.27, 

.34, 

.55, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1, 

,0, 

6 

.27, 

.26, 

.28, 

.40, 

.65, 

1.0. 

o 

1 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1, 

,0, 

7 

.27, 

.26, 

.31, 

.48, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1, 

,0, 

8 

.27, 

.27, 

.36, 

.57, 

1.0, 

1.0. 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1, 

,0, 

9 

.27, 

.29, 

.43, 

.67, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1, 

,0, 

0 

.27, 

.32, 

.51, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0, 

1, 

,0, 

1 

.27, 

.37, 

.61, 

1.0, 

1.0, 

1.0, 

1.0, 

1.0. 

1.0, 

1.0, 

1.0, 

1.0, 

1, 

,0/ 

ARRAYS  TAVNP  AND  TAVNQ  CONTAIN  THE  HIGHEST  ALLOWABLE  ADJUSTED  VNS 
FOR  WHICH  THE  POLYNOMIAL  CURVE  FIT  DATA  IS  VALID,  TSHOBP  AND 
TSHOBQ  CONTAIN  THE  HIGHEST  ALLOWABLE  SCALED  HOBS  FOR  WHICH  THE 
SAME  DATA  IS  VALID 


DATA  TAVNP 

/  81. 

,  56. 

,  56. 

.  56., 

56. 

,  53. 

.  50. 

.  44. 

.  39., 

A 

35. 

,  31. 

,  26. 

.  23., 

20. 

,  17. 

.  16. 

.  14. 

.  13./ 

DATA  TAVNQ 

/  31. 

,  31. 

,  31. 

.  29., 

26. 

,  22. 

,  20. 

,  18. 

,  16., 

A 

14. 

.  12. 

.  11. 

.  9./ 

DATA  TSHOBP 

/  0. 

,  0. 

,  20. 

,  40., 

60. 

,  80. 

,100. 

,150. 

,200., 

A 

250. 

,300. 

,400. 

,500., 

600. 

,700. 

,800. 

,900. 

,1000., 

DATA  TSHOBQ 

/  0. 

,  50. 

,100. 

,150.. 

-00. 

,300. 

,400. 

,500. 

,600. , 

A 

700. 

,800. 

,900. 

,1000. 

/ 

C 

TGTSIG  =  DSIG 

TGSGIC  =  1.  /  (1.  -  TCTSIG’^^f^a) 

IF  (KF  .GE.  0  .AND.  KF  .LT.  10)  GO  TO  10 
lERR  =  6 
RETURN 
10  JT  =  JJT 
VN  =  IV 
FK  =  KF 

YLDCU  =  YLD**. 33333333 
YLDIC=  1. /YLDCU 
SHOB=  H0B1*YLDIC 
FKIO  =  FK*.l 
C 

C  CALCULATE  ADJUSTED  VN  USING  THE  FOLLOWING  FORMULA,  FROM  DIA 

C  PHYSICAL  VULNERABILITY  HANDBOOK  -  NUCLEAR  WEAPONS  AP-550-1-2-69 

C 

C  ADJUSTED  VN  =  VN  +  D  *  LOG{R) 

C  WHERE, 

C  D  =  2.742  (FOR  Q  TYPE)  OR  5.485  (FOR  P  TYPE) 

C  R  =  l-(KFACT0R/10)+(KFACTOR/i;)*((20/YLD)**l/3)*(R**C) 

C  C  =  1/3  (FOR  Q  TYPE)  OR  1/2  (FOR  P  TYPE) 

C 

IF  (JT  .EQ.  1)  GO  TO  20 
C  SET  VALUES  FOR  'Q'  TYPE 

R  =  3.0 

CEXP  =  .33333333 
D  =  2.742 
TBSGIC  =1.10 


CJ  CJ  CJ  O  O  CJ  CJ 


135  - 


GO  TO  30 
20  CONTINUE 

C  SET  VALUES  FOR  'P'  TYPE 

R  =  2.0 
CEXP  =  .5 
D  =  5.485 
TBSGIC  =1.04 
30  CONTINUE 

THIS  ALGORITHM  FINDS  THE  PROPER  "R”  VALUE  AND  CALCULATES  AVN 

40  R1  =  l.-FK10*(l.-2.7144176*YLDIC*(R**CEXP)) 

ABDIF  =  R1  -  R 
R  =  R1 

ABDIF  =  ABS (ABDIF) 

IF  (ABDIF  .GE.  .001)  GO  TO  40 
AVN  =  VN  +  D  *  ALOG(R) 

SET  THE  SUBSCRIPTS  FOR  ENTERING  THE  COEFFICIENT  TABLE.  FIRST 
CHECK  FOR  SHOB  =  0 

IF  (SHOB  .GT.  0.)  GO  TO  140 
IF  (JT  .EQ.  1)  GO  TO  80 

C  'Q'  TYPE  TARGETS 

IF  (AVN  .LE.  TAVNQ(l))  GO  TO  60 
lERR  =  2 
RETURN 
60  CONTINUE 
IHI  =  1 
ILO  =  1 

C  SET  THE  SUBSCRIPT  FOR  THE  Q  DAMAGE  SIGMA  TABLE 
lAVN  =  AVN 
lAVN  =  lAVN  +  1 
GO  TO  300 
80  CONTINUE 

C  'P'  TYPE  TARGETS 

IF  (AVN  .LE.  TAVNP(2))  GO  TO  100 
IF  (AVN  .LE.  TAVNP(l))  GO  TO  120 
lERR  =  2 
RETURN 
100  CONTINUE 

IHI  =  2 
ILO  =  2 
GO  TO  400 
120  CONTINUE 

IHI  =  1 
ILO  =  1 
GO  TO  400 

C 

C  SET  THE  COEFFICIENT  SUBSCRIPTS  FOR  NON  ZERO  SHOBS. 

IF  (JT  .EQ.  1)  GO  TO  200 


140 
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C  SET  THE  SUBSCRIPT  FOR  ’Q'  TYPE 

IF  (SHOE  .LE.  TSH0BQ(13))  GO  TO  150 
lERR  =  12 
RETURN 
150  1=2 

160  IF  (SHOE  .LT.  TSHOBQ(I))  GO  TO  165 

IF  (SHOE  .EQ.  TSHOBQ(I))  GO  TO  170 

1  =  1  +  1 
GO  TO  160 
165  CONTINUE 

IHI  =  I 
ILO  =  I  -  1 
GO  TO  175 
170  CONTINUE 

IHI  =  I 
ILO  =  I 
175  CONTINUE 

C  SET  THE  SUBSCRIPT  FOR  THE  Q  DAMAGE  SIGMA  TABLE 
lAVN  =  AVN 
lAVN  =  lAVN  +  1 

C  ENSURE  riVN  IS  WITHIN  THE  RANGE  OF  THE  POLYNOMIAL  TABLES 

IF  (AVN  .LE.  TAVNQ(ILO)  .AND.  AVN  .LE.  TAVNQ(IHI))  GO  TO  300 
lERR  =  2 
RETURN 

C 

200  CONTINUE 

C  SET  SUBSCRIPT  FOR  'P'  TYPE 

IF  (SHOE  .LE.  TSH0BP(18))  GO  TO  250 
lERR  =  12 
RETURN 

C  START  THE  SEARCH  OF  THE  TABLE  AT  ENTRY  3,  BECAUSE  THERE  ARE 

C  2  ENTRIES  FOR  SHOB  =  0 

250  1=3 

260  IF  (SHOB  .LT.  TSHOBP(I))  GO  TO  265 

IF  (SHOB  .EQ.  TSHOBP(I))  GO  TO  270 

1  =  1  +  1 
GO  TO  260 
265  CONTINUE 

IHI  =  I 
ILO  =  I  -  1 
GO  TO  275 
270  CONTINUE 

IHI  =  I 
ILO  =  I 

C  ENSURE  AVN  IS  WITHIN  THE  RANGE  OF  THE  POLYNOMIAL  TABLES 

275  IF  (AVN  .LE.  TAVNP(ILO)  .AND.  AVN  .LE.  TAVNP(IHI))  GO  TO  400 

lERR  =  2 
RETURN 

C 

300  CONTINUE 

C  'Q'  TYPE  METHODOLOGY 


C  SET  THE  INTERPOLATION  FACTOR  FOR  THE  WEAPON  RADIUS  BETWEEN 

C  SHOE  BANDS.  IF  THE  USER  HAS  NOT  INPUT  A  DAMAGE  SIGMA 

C  (IFLG  8  OR  9)  USE  THE  Q  DAMAGE  SIGMA  TABLE 
C 

FAC  =  0, 

CSDG  FOLLOWING  LINE  CHANGED  PER  JCS(J-8)  15  JUL  87 
CSDG  IF  (IHI  .EQ.  ILO)  GO  TO  305 

IF  (IHI  .EQ.  ILO)  GO  TO  310 

FAC  =  (SHOE  -TSHOBQ(ILO))  /  (TSHOBQ(IHI)  -  TSHOBQ(ILO)) 

C  305  IF  (IFLG  .EQ.  8  .OR.  IFLG  .EQ.  9)  GO  TO  310 
C  USE  THE  DAMAGE  SIGMA  VALUE  ROUNDED  TO  THE  NEAREST  TENTH 
C  TBLSIG=QSIG(ILO,IAVN)  +  FAC*(QSIG(IHI , lAVN)  -  QSIG(ILO,IAVN)) 

CSDG  DEBUG  FOR  JAD  PROBLEM  IN  SWADE 

CSDG  IF(TBLSIG.GT.1.)WRITE(6,6000)YLD,H0B1,IV,JJT,KF,DSIG, 

CSDG  1  ILO.IHI.IAVN.FAC.TBLSIG 
CSDG6000  F0RMAT(2F10 . 2 , 31 10 ,F5 . 2 , 315 , 2FiO . 2) 

C  ITBLSG  =  TBLSIG  *  10.  +  .5 

C  TBLSIG  =  ITBLSG  *  .1 

C  TBSGIC  =!./(!.-  TBLSIG**2) 

310  CONTINUE 

SWRL=  WQ( 1 , IL0)+AVN*(WQ(2 , IL0)+AVN*(WQ(3 , IL0)+AVN*(WQ(4 , ILO)+ 

1  AVN*(WQ(5 , IL0)+AVN*(WQ(6 , IL0)+AVN*(WQ(7 , IL0)+AVN*WQ(8 , ILO) )))))) 
SWRH=  WQ(1,IHI)+AVN*(WQ(2,IHI)+AVN*(WQ(3,IHI)+AVN*(WQ(4,IHI)+ 

1  AVN*(WQ(5,IKI)+AVN*(WQ(6,IHI)+AVN*(WQ(7,IHI)+AVN*WQ(8,IHI))))))) 
GO  TO  500 
C 

400  CONTINUE 

C  'P'  TYPE  METHODOLOGY 

C  SET  THE  INTERPOLATION  FACTOR  FOR  THE  WEAPON  RADIUS  BETWEEN 
C  SHOB  BANDS . 

C 

FAC  =  0, 

IF  (IHI  .EQ.  ILO)  GO  TO  410 

FAC  =  (SHOB  -TSHOBP(ILO))  /  (TSHOBP(IHI)  -  TSHOBP(ILO)) 

410  CONTINUE 

SWRL=  WP ( 1 , I LO ) +AVN* ( WP ( 2 , I LO ) +AVN* ( WP ( 3 , I LO ) +AVN* ( WP ( 4 . I LO ) + 

1  AVN* (WP ( 5 , I LO ) +AVN* (WP ( 6 , I LO ) +AVN* ( WP ( 7 , I LO ) +A VN*WP ( 8 , I LO ) ) ) ) ) ) ) 
SWRH=  WP ( 1 . I H I ) +AVN* (WP ( 2 , IHI ) +AVN* ( WP ( 3 , IH I ) +AVN* ( WP ( 4 , I H I ) + 

1  AVN* (WP (5 , IHI )+AVN* (WP(6 , IHI )+AVN* (WP ( 7 , IHI )+AVN*WP(8 , IHI )))))) ) 
C 

500  CONTINUE 

SWRL  =  EXP(SWRL) 

SWRH  =  EXP(SWRH) 

WRl  =  (SWRL  +  FAC* (SWRH -SWRL))  *  YLDCU 
WRFAC  =  TGSGIC  /  TBSGIC 
WR  =  WRl  *  WRFAC 
600  CONTINUE 

IF  (WR.LE. .0)  WR  =  .0 

RETURN 

END 


OOOO  0C30  OOCJO  O  0C300 
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c 

SUBROUTINE  PVDS4  (  IV,  KF,  YLD,  HOBl,  DSIG,  WR,  IFLG,  lERR) 

C 

CVf****V?****Vf>V*Vf*Vr*Vf**Vf*A**iV****VfAiVVnV*VrVf****VriWf****i!r>V***Vf**Vf**5V**yr>V*Vf^VA* 

C  THIS  SUBROUTINE  CALCULATES  WEAPON  RADIUS  FOR  'H'  TYPE  VNTKS. 

C  USING  THE  MEHTODOLOGIES  SPECIFIED  IN  THE  PHYSICAL  VULNERABILITY 

C  DATA  SHEETS 
C 

C  CALLED  FROM:  MAIN 

C  SUBROUTINES  CALLED:  NONE 

C  ERROR  FLAGS  SET:  17  10  14  15 

C 
C 

DIMENSION  COEF(20,2),  EXPNT(20,2),  YLDMIN(20,2) 


1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

DATA 

COEF/  229. 

,229., 

231., 

136., 

230., 

185.  , 

136., 

28., 

33., 

40., 

A 

28. 

.  0., 

0., 

0., 

0., 

0., 

0., 

0., 

0., 

0., 

B 

131. 

,131., 

148., 

148. , 

148. , 

89., 

89., 

28., 

33.  , 

40., 

C 

28. 

.  0., 

0., 

0., 

0., 

0.. 

0.. 

0., 

0.. 

0./ 

DATA 

EXPNT/.311 

,.311, 

.310, 

.357, 

.321, 

.367, 

.357, 

.546, 

.385, 

.352, 

A 

.406 

,  .0, 

.0, 

.0, 

.0, 

.0, 

.0, 

.0, 

.0, 

.0, 

B 

.352 

,.352, 

.325, 

.325, 

.323, 

.381, 

.381, 

.546, 

.385, 

.352, 

C 

.406 

,  .0, 

.0, 

.0, 

.0, 

.0, 

.0, 

.0, 

.0, 

.0/ 

1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

DATA 

YLDMIN/20. 

.  20., 

20., 

20., 

20., 

20., 

20. , 

100. , 

280.  , 

1000. 

A 

480. 

1  0  • » 

0.. 

0., 

0., 

0., 

0.. 

0., 

0., 

0., 

B 

20. 

.  20., 

20., 

20., 

20., 

100., 

100. , 

100. , 

280.  , 

1000. 

C 

480. 

,  0., 

0., 

0., 

0., 

0., 

0., 

0., 

0., 

0./ 

DATA  IVMAX  /  11  / 

--  K  FACTOR  OF  1  (MODERATE  DMG)  OR  2  (SEVERE  DMG)  ALLOWED 
IF  (  KF  .EQ.  1  .OR.  KF  .EQ.  2  )  GO  TO  10 
lERR  =  7 
RETURN 

--  PVDS  8-11  DEFINE  SEVERE  DAMAGE  ONLY.  IF  MODERATE  DAMAGE 
IS  REQUESTED,  CALCULATE  SEVERE  AND  SET  ERROR  FLAG  TO  WARN 
USER  THAT  SEVER  DAMAGE  HAS  BEEN  CALCULATED 
10  IF  (  (IV  .GE.  8  .AND.  IV  .LE.  11)  .AND.  KF  .EQ.  1)  lERR  =15 
C 

C . ENSURE  VN  VALUE  IS  LEGAL 

IF  (IV  .GT.  0  .AND.  IV  .LE.  IVMAX)  GO  TO  20 
lERR  =  14 
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RETURN 

C 

C .  ALL  PVDS  TARGETS  REQUIRE  CONTACT  BURST 

20  IF  (HOBl  .GE.  0.  .AND.  HOBl  .LT.  .99)  GO  TO  30 
lERR  =  10 
RETURN 
C 

C .  ENSURE  YLD  IS  ABOVE  MINIMUM  REQUIRED  YIELD  FOR  TARGET 

30  IF  (YLD  .GE.  YLDMIN(IV,KF))  GO  TO  40 
lERR  =  1 
RETURN 
C 

40  CONTINUE 
C 

WR  =  COEFdV.KF)  *  (YLD**EXPNT(IV,KF) ) 

DSIG  =  .3 

RETURN 

END 

C>Vi'fVf***iVVf***Vf*Vf*****Vf>V')'f*Vf****iV*ilnMrA**Vf****iV*****VfA*Vf****5'f***j’nh'f*****A>ViV 

C 

SUBROUTINE  WRPER4  (YLD,  HOBl,  IV,  JJT,  KF,  DSIG,  WR,  lERR) 

C 

CiV*****AA*VfAAAAA*A*A*AA*A**iVA***iMf*AiWnVAA*A**iVAAAA*AiVAAA**A*iV***iVAA*AA* 

C 

C  THIS  ROUTINE  CALCULATES  THE  WEAPON  RADIUS  FOR  CALCULATION  OF 
C  PERSONNEL  FATALITIES  AND  CASUALTIES 
C 

C  CALLED  FROM:  MAIN 

C  SUBROUTINES  CALLED:  NONE 

C  ERROR  FLAGS  SET:  8  12 

C 

DIMENSION  S(6),T(6),NM(16),LI(39),LK(40),A(32),B(32),CH(562) 
DIMENSION  CH1(64),CH65(60),CH125(53),CH178(69),CH247(70), 

X  CH317(72) ,CH389(48) ,CH437(42) ,CH479(42) ,CH521(42) 

EQUIVALENCE  (CHl(l) ,CH(1)) , (CH65(1) ,CH(65)) , (CH(125) ,CH125(1)) , 

X  (CH178(1),CH(178)),(CH247(1),CH(247)),(CH(317),CH317(1)), 

X  (CH389(1) ,CH(389) ) , (CH437(1) ,CH(437)) , (CH479(1) ,CH(479)) , 

X  (CH521(1),CH(521)) 

C  THE  FOLLOWING  TABLES  ARE  USED  FOR  CALCULATING  WEAPON  RADIUS  OF  99X 
C  TYPE  TARGETS . 

C 

C  LISTS  S  AND  T  ARE  USED  TO  STORE  TERMS  OF  CHEBYSHEV  POLYNOMIALS 
C  FOR  NORMALIZED  YIELD  AND  SHOB 
C  LIST  NM  IS  CUMULATIVE  KEY  TO  WR  FIT  SUBTABLES 
C  LISTS  LI  AND  LK  SUPPLY  KEYS  TO  LIST  CH 
C  LIST  CH  CONTAINS  COEFFICIENTS  FOR  WR  FIT 
C 

DATA  S(1),T(1)/1.,1./ 

+,NM/1, 4, 6, 9, 11, 14, 16, 19, 22, 25, 26, 30, 32, 35, 38, 39/  , LI/3, 4*4, 3, 4*4, 
+5, 3, 3*4, 5, 4, 3, 5, 4, 3, 6, 5, 3, 5, 5, 4, 3*3, 5, 6, 4, 4, 6, 4, 4, 6, 6/ 

+, LK/0, 12, 24, 36, 52, 64, /6, 88, 100, 112, 124, 144, 153, 165, 177, 189, 214, 234 
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+,246,271,283,292,316,336,348,373,388,400,406,412,421,436,454,466, 

+478,496,508,520,544,562/ 


DATA  (CH(I),I= 

1,  64)  / 

TABLE  III  - 

1 

,  N=1 

DATA  CHI 

/ 

A  538.1, 

-39.5, 

-52.1, 

-30.9, 

B  422.2, 

-62.4, 

-62.8, 

-52.4, 

C  44.1, 

-14.8, 

-17.6, 

-18.9, 

TABLE  III  - 

1 

,  N=2 

D  1706.3, 

197.2, 

-107.1, 

E  3334.9, 

1036.8, 

142.0, 

F  1031.1, 

76.8, 

-121.8, 

G  621.6, 

181.0, 

28.2, 

TABLE  III  - 

1 

,  N=3 

K  5055.6, 

-4552.1, 

1862.5, 

I  -11696.7, 

22289.7, 

-8102.4, 

J  5038.9, 

-5562.1, 

2274.4, 

K  -4369.0, 

7269.2, 

-2684.7, 

TABLE  III  - 

2 

,  N=4 

L  3591.6, 

1515.9, 

399.9, 

361.3, 

M  5127.9, 

2364.2, 

666.0, 

586.1, 

N  2195.9, 

1099.2, 

351.0, 

310.6, 

0  464.2, 

240.9, 

92.1, 

83.0, 

TABLE  III  - 

2 

,  N=5 

P  3116.5, 

710.2, 

-49.3, 

Q  6719.7, 

1755.5, 

-137.0, 

R  1756.3, 

399.1, 

-26.4, 

S  1169.2, 

300.3, 

-26.0/ 

TABLE  III  - 

3 

,  N=6 

DATA  CH65 

/ 

A  511.1, 

-44.2, 

-26.3, 

3.3, 

B  343.5, 

-72.1, 

-23.4, 

-2.7, 

C  15.9, 

-18.1, 

-4.5, 

-2.9, 

TABLE  III  - 

3 

,  N=7 

D  1475.7, 

427.2, 

35.2, 

E  2369.8, 

478.3, 

52.6, 

F  903.1, 

375.9, 

34.1, 

G  448.2, 

-9.2, 

-29.5, 

TABLE  III  - 

3 

,  N=8 

H  310.6, 

2224.8, 

-581.9, 

I  2943.8, 

-1062.7, 

-21.9, 

J  -8.5, 

1901.6, 

-363.2, 

K  1264.4, 

-1308.1, 

397.0, 

TABLE  III  - 

4 

,  N=9 

L  3195.1, 

1464.3, 

279.8, 

M  4503.0, 

2298.3, 

470.8, 

N  1964.7, 

1091.7, 

246.4, 

0  435.5, 

246.5, 

63.6, 

TABLE  III  - 

4 

,  N=10 

P  2821.6, 

604.3, 

-59.2, 
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Q 

5935.3, 

1618.3, 

-94.5, 

R 

1602.9, 

328.2, 

-40.1, 

s 

1034.0, 

278.1, 

-12.7/ 

c 

DATA  (CH(I) 

,1=125,177) 

/ 

c 

TABLE  III  - 

5  ,  N=ll 

DATA  C.W125 

/ 

A 

1496.5, 

372.6, 

78.3, 

3.3, 

B 

1956.8, 

577.2, 

119.2, 

-16.9, 

C 

943.8, 

332.0, 

60.6, 

-12.6, 

D 

356.8, 

100.3, 

9.6, 

-.1. 

E 

64.6, 

-7.0, 

-10.9, 

-.8, 

c 

TABLE  III  - 

5  ,  N=12 

F 

881.3, 

-535.8, 

38.3, 

G 

874.4, 

-804.2, 

65.8, 

H 

190.8, 

-278.2, 

27.7, 

c 

TABLE  III  - 

5  ,  N=13 

I 

1418.4, 

835.9, 

660.6, 

J 

-1473.6, 

3950.5, 

-3648.9, 

K 

757.4, 

1053.0, 

696.4, 

L 

204.4, 

143.8, 

-410.1, 

c 

TABLE  III  - 

6  ,  N=14 

M 

1816.8, 

303.2, 

-209.0, 

N 

2265.0, 

448.0, 

-314.6, 

0 

847.8, 

187.3, 

-154.1, 

P 

171.7, 

30.8, 

-39.2/ 

c 

DATA  (CH(I) 

,1=178,246) 

/ 

c 

TABLE  III  - 

6  ,  N=15 

DATA  CHI 78 

/ 

A 

2213.5, 

430.9, 

-71.5, 

B 

4457.7, 

1154.4, 

-15.5, 

C 

1173.5, 

253.9, 

-54.2, 

D 

801.4, 

184.7, 

-3.7, 

c 

TABLE  III  - 

llA  ,  N=16 

E 

-247.8, 

-1234.0, 

-621.2, 

-148.2, 

20.3, 

F 

-767.2, 

-2067.6, 

-1033.6, 

-256.2, 

45.1, 

G 

-635.7, 

-1202.3, 

-612.5, 

-150.9, 

38.7, 

H 

-262.0, 

-471.1, 

-247.6, 

-53.9, 

22.1, 

I 

-53.3, 

-102.6, 

-55.0, 

-9.2, 

7.2, 

c 

TABLE  III  - 

llA  ,  N=17 

J 

-3617.0, 

-7824.1, 

-6433.1, 

-3799.1, 

-1141.6, 

K 

4213.8, 

8832.9, 

11023.7, 

8211.2, 

2830.5, 

L 

-3966.9, 

-7719.2, 

-6392.5, 

-3806.3, 

-1134.1, 

M 

1178.4, 

2731.0, 

3395.8, 

2551.9, 

901.9, 

c 

TABLE  III  - 

llA  ,  N=18 

N 

-27720.8, 

-49305.0, 

-27982.8, 

-8218.3, 

0 

37489.9, 

65058.5, 

37703.2, 

11270.9, 

P 

-10966.7, 

-19824.7, 

-11131.7, 

-3256.3/ 

C  DATA  (CH(I) ,1=247,316)  / 

DATA  CH247  / 


C  TABLE  III  -12A  ,  N=19 

A  325.1,  -986.7,  -741.7,  -416.4, 


-133.5, 
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B 

220.1, 

-1491.4, 

-1118.4, 

-648.9, 

-199.0, 

c 

45.5, 

-667.7, 

-525.6, 

-318.0, 

-94.5, 

D 

63.3, 

-179.0, 

-158.5, 

-98.5, 

-32.0, 

E 

27.7, 

-29.7, 

-30.3, 

-18.5, 

-7.3, 

c 

TABLE  III  -12A 

,  N=20 

F 

931.3, 

-1252.0, 

-164.1, 

G 

1034.8, 

-1886.8, 

-295.4, 

H 

257.1, 

-793.2, 

-208.7, 

I 

20.8, 

-148.6, 

-77.5, 

c 

TABLE  III  -12A 

,  N=21 

J 

2312.0, 

-1951.4, 

-451.1, 

K 

1267.0, 

-2232.0, 

1482.1, 

L 

1773.7, 

-1609.5, 

-173.8, 

c 

TABLE  III  -IIB 

,  N=22 

M 

448.3, 

-307.1, 

-101.0, 

-17.3, 

N 

405.8, 

-524.7, 

-179.0, 

-57.8, 

0 

139.1. 

-192.5, 

-69.9, 

-38.8, 

P 

193.9, 

143.2, 

75.4, 

13.5, 

Q 

130.6, 

149.2, 

72.1, 

18.5, 

R 

4.0, 

-5.9, 

-10.4, 

-3.7/ 

c 

DATA  (CH(I).I=: 

317,388) 

/ 

DATA  CH317 

/ 

c 

TABLE  III  -IIB 

,  N=23 

A 

-1092.0, 

659.2, 

-1525.0, 

630.3, 

B 

-2302.9, 

1343.1, 

-2677.2, 

1136.4, 

C 

-1705.2, 

1128.3, 

-1753.1, 

784.3, 

D 

-799.2, 

669.9, 

-816.3, 

392.0, 

E 

-212.7, 

225.3, 

-222.2, 

114.6, 

c 

TABLE  III  -IIB 

,  N=24 

F 

5145.1, 

-7147.4, 

3164.7, 

-144.9, 

G 

-6229.4, 

9549.0, 

-4581.7, 

897.3, 

H 

2352.1, 

■2946.0, 

1198.2, 

192.0, 

c 

TABLE  III  -12B 

,  N=25 

I 

1552.9, 

252.5, 

-60.7, 

-68.7, 

-26.5, 

J 

2096.1, 

382.0, 

-78.9, 

-108.1, 

-34.9, 

K 

915.6, 

181.8, 

-36.2, 

-48.5, 

-13.6, 

L 

297.0, 

46.3, 

-14.0, 

-11.8, 

-4.9, 

M 

58.0, 

3.1, 

-3.5, 

-2.1, 

-1.5, 

c 

TABLE  III  -14 

,  N=26 

N 

2495.8, 

530.8, 

-39.0, 

0 

3584.0, 

836.7, 

-50.3, 

P 

1716.9, 

392.1, 

-40.2, 

Q 

521.7, 

91.8, 

-18.6, 

R 

72.1, 

11.0, 

.6/ 

c 

DATA  (CH( I), 1=389, 436) 

/ 

DATA  CH389 

/ 

c 

TABLE  III  -14 

,  N=27 

A 

883.9, 

2319.7, 

-538.2, 

B 

989.4, 

3^16.8, 

-790.9, 

C 

447.4, 

1590.4, 

-267.7, 

D 

152.6, 

297.2, 

-14.8, 

143 


C  TABLE  III  -14  ,  N=28 


E  -30638.8,  43111.4, 
F  43828.5,  -52525.1, 
G  -24879.6,  34686.8, 


c 

TABLE  III  -14 

,  N=29 

H 

8664.5, 

1263.4, 

I 

-5298.4, 

-1069.9, 

J 

5902.9, 

777.7, 

c 

TABLE  III  -15 

,  N=30 

K 

869.2, 

161.4, 

-26.6, 

L 

804.6, 

224.6, 

-23.8, 

M 

153.1, 

73.8, 

-4.8, 

c 

TABLE  III  -15 

,  N=31 

N 

4188.7, 

1085.1, 

-67.6, 

0 

5210.5, 

1195.5, 

-112.9, 

P 

3268.1, 

949.0, 

-43.5, 

Q 

616.9, 

72.4, 

-21.8, 

R 

277.0, 

116.9, 

6.2/ 

c 

DATA  (CH(I),I= 

=437,478) 

/ 

DATA  CH437  / 


TABLE  III  - 

16A  ,  N=32 

A 

2763.7, 

475.7, 

-92.8, 

B 

4165.0, 

879.8, 

-158.0, 

C 

1998.9, 

624.0, 

-105.5, 

D 

678.7, 

313.1, 

-53.3, 

E 

180.8, 

100.1, 

-14.4, 

F 

39.1, 

16.6, 

2.3, 

TABLE  III  - 

16A  ,  N=33 

G 

54.4, 

-3019.6, 

-1270.6, 

H 

-71.6, 

-4518.7, 

-1848.7, 

I 

-159.0, 

-1967.7, 

-751.6, 

J 

-59.9, 

-416.8, 

-144.4, 

TABLE  III  - 

16A  ,  N=34 

K 

358367.6, 

520343.9, 

165511.7, 

L 

-559255.1, 

-822777.0, 

-263079.9, 

M 

291463.4, 

424061.4, 

135192.3, 

N 

-65192.0, 

-96277.0, 

-31131.7/ 

C  DATA  (CH(I), 1=479, 520)  / 

DATA  CH479  / 

C  TABLE  III  -16B  ,  N=35 


A 

3659.6, 

809.4, 

-118.7, 

B 

5515.8, 

1458.8, 

-210.0, 

C 

2638.5, 

1003.0, 

-140.6, 

D 

891.8, 

489.0, 

-68.2, 

E 

241.5, 

148.3, 

-13.4, 

F 

55.1, 

21.0, 

8.1, 

TABLE  III  -16B 

,  N=36 

G 

-55.5, 

-4178.2, 

-1704.7, 

H 

-312.6, 

-6309.3, 

-2497.8, 

I 

-351.8, 

-2809.3, 

-1034.0, 

J 

-131.2, 

-620.8, 

-206.6, 

C 
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C  TABLE  III  -16B  ,  N=37 


K 

505974.8, 

734336.1, 

232815.5, 

L 

-792454.4, 

-1163833.9,  • 

-370734.3, 

M 

413597.8, 

601382.9, 

191085.0, 

N 

-94345.2, 

-138879.9, 

-44740.8/ 

DATA(CH(I), 

1=521,562) 

/ 

DATA  CH521 

/ 

TABLE  III  - 

13  ,  N=38 

A 

195.8, 

-56.9, 

-34.1, 

-6.7, 

B 

249.7, 

-154.1, 

-105.2, 

-33.7, 

C 

144.2, 

-2.3, 

.3, 

2.5, 

D 

22.0, 

-45.5, 

-32.6, 

-12.0, 

E 

16.8, 

12.1, 

9.4, 

4.2, 

F 

-.1, 

-5.3, 

-3.9, 

-1.1. 

TABLE  III  - 

16C  ,  N=39 

G 

4604.8, 

1135.1, 

-84.1, 

H 

6750.2, 

1763.8, 

-118.9, 

I 

3250.3, 

840.2, 

-60.1, 

J 

984.3, 

241.6, 

-15.9, 

K 

196.7, 

64.9, 

'.2, 

L 

57.1, 

23.5, 

-1.5/ 

C 

DATA  THIRD  /. 33333333/ 

C 

DATA  A/1. 6, 2. 3,. 75, 1-6,. 25,. 9, 1.6, 1.5, 1.7, 

+-.5,. 55, 3. 7, 2. 79, 1.35, 2. 15, -1.3, 2. ,2. 79,. 225, 3. 99,1. ,1.5, 2. 2, -.4, 
+.7,1.55, .8, 1.2, 1.8, -2.,. 9, 1.6/  ,B/- . 00071 ,-. 000999 ,. 0005 ,0 . , 

+- . 000249 , - . 00055 , - . 000749 , - . 00067 , - . 00053 , . 0024 , - . 0005 , - . 00233 , 
+.0007 1 , . 00175 , - . 00225 , . 0035 , . 00175 , - . 0022 , . 0035 , - . 00229 , - . 00067 , 
+- . 00067 , - . 00087 ,.0012,. 0004 , 0 . , - . 00055 , - . 00045 , - . 00055 , 0 . , - . 0006 , 


+-.00065/ 

C 
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N=NM(KF) 

GOTO  (101,102,103,104,105,106,107,108,109,110,111,112,113,113,115, 
+116), KF 

C  FIND  SECTION  OF  TABLE 

101  KS=2 

IF  (SHOE. GT. 700. )KS=4 
IF  (YLD.LT.IO.)  GOTO  142 
N=N+1 

IF  ( SHOE. GE. 800.)  N=N+1 
GOTO  142 

102  KS=6 

IF  (YLD.GT.IO.)  N=N+1 
GOTO  141 

103  IF  (YLD.LE.IO.)  GOTO  200 
N=N+1 

IF  (SHOE. GT. 700.)  N=N+1 
GOTO  200 

104  KS=8 

IF  (YLD.GT.IO.)  N=N+1 
GOTO  143 

105  KS=9 

IF  (SHOE. GT. 750.)  KS=10 
IF  (SHOE. LE. 700.)  GOTO  144 
N=N+1 

IF  (YLD.GT.40.)  N=N+1 
GOTO  144 

106  KS=11 

IF  (YLD.GT.IO.)  N=N+1 
GOTO  144 

107  KS=12 

IF  (SHOE. GT. 300.)  KS=13 
IF  (YLD.GT.IOO.)  N=N+1 
IF  (YLD.GE.2000.)  N=N+1 
GOTO  144 

108  KS=14 

IF  (SHOE. GT. 200.)  KS=15 
IF  (SHOE. GT. 600.)  KS=16 
IF  (SHOE. LT. 700.)  GOTO  144 
N=N+1 

IF  (YLD.GT.200.)  N=N+1 
GOTO  144 

109  KS=17 

IF  (SHOE. GT. 200.)  KS=18 
IF  (SHOE. GT. 450.)  KS=19 
IF  (SHOE. GT. 650.)  KS=20 
IF  (SHOE. LT. 500.)  GOTO  144 
N=.N+1 

IF  (YLD.LE.700. .AND.X.LT. .53-.5*Y)  GOTO  144 
IF  (SHOE. GT. 800.)  RETURN 
N=N+1 
GOTO  144 
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110  DSIG=.4 
GOTO  200 

111  KS=22 

IF  (SHOE. GT. 750.)  KS=25 
IF  (YLD.GT.200.)  GOTO  121 
IF  (SHOE. GE. 800.)  N=N+1 
GOTO  141 

121  IF  (SHOE. LT. 900.)  GOTO  141 
N=N+2 

IF  (YLD.GE.IOOO.)  N=N+1 
GOTO  141 

112  KS=28 

IF  (YLD.GT.4.)  N=N+1 
GOTO  141 

113  IF  (YLD.GE.400.)  GOTO  123 
IF  (SHOE. LT. 300.)  N=N+1 
GOTO  200 

123  IF  (SHOE. LE. 200.)  N=N+2 
GOTO  200 

115  IF  ( SHOE. GT. 400.)  RETURN 
IF  (X.LT. .75*Y-1.)  RETURN 
GOTO  200 

116  KS=31 

C  FIND  KSIG  PARTITIONS 

141  X45=A(KS+1)+E(KS+1)*SH0E 
IF  (XL.LE.X45)  GO  TO  142 
DSIG  =  .5 

GO  TO  200 

142  X25=A(KS-1)+E(KS-1)*SH0E 
IF(  XL  .LE.  X25  )  DSIG=.2 

143  X35=A(KS)+E(KS)*SH0E 

IF(  XL  .GT.  X35  )  DSIG  =  .4 
GO  TO  200 

144  DSIG  =  .4 
X45=A(KS)+E(KS)*SH0E 

IF(  XL  .LT.  X45  )  DSIG=.5 
C  COMPUTE  WR 

200  K=LK(N) 

IL=LI(N) 

JL=(LK(N+1)-K)/IL 
DO  2  1=1, IL 
C=0. 

DO  3  J=1,JL 
K=K+1 

3  C=C+CH(K)*T(J) 

2  WR=WR+C*S(I) 

IF  (WR.LT.O.)  WR=0. 

WR=WR*10. 

RETURN 
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C 

C 

C** 

C 

C 

C 

C 

C 

C 

C 

C 


C 


SUBROUTINE  LNCAL4  (CEP,  DSIG,  WR,  R95,  POD,  D,  IFLG,  lERR) 


**5V**5VVw'f***Vf5V?'f*****VrVf*;VVf*i'r5'fVf****VrVf****5V'>V****A***'!V'!VVf**Vf*5V*iV**?V***?V5V** 


SUBROUTINE  LNCAL4  IS  A  SUBROUTINE  USED  TO  CALCULATE  POD  AND 
OFFSET  DISTANCE  USING  THE  LOG  NORMAL  PROBABILITY  FCTN 

CALLED  FROM:  MAIN 

SUBROUTINES  CALLED:  INTGF4 
ERROR  FLAGS  SET:  1 

DIMENSION  W(5),  ZP(5) 

LOGICAL  CROSS 

DATA  W  /  .0666713443,  .1494513492,  .2190863625,  .2692667193, 
W  .2955242247/, 

Z  ZP  /  .9739065285,  .8650633667,  .6794095683,  .4333953941, 
P  .1488743390/ 


IF  (IFLG.EQ.6)  D=0. 

D  =  D  *  6076.1155 
ITCH=0 

RR5  =  6076.1155  *  R95 

ADCEP  =  SQRT(CEP**2  +  .231  *  RR5**2) 

IF  (WR.LE. .001)  GO  TO  40 

COMPUTE  BETA-FACTOR  USED  IN  COMPUTING  Z,  THE  UPPER  LIMIT  OF  THE 
INTEGRAL.  ALSO  COMPUTE  'ADJUSTED  CEP',  ADCEP,  USE  IT  TO  NORMALIZE 
D  AND  WR. 

10  EX  =  l.-DSIG**2 

BETA  =  SQRT(-ALOG(EX)) 

IF  (ADCEP. GT. 0.00)  GO  TO  50 

COMPUTE  POD  WHEN  CEP  =  R95  =  0 

IF  D  ALSO  EQUALS  0  SET  POD  =  .999 
OTHERWISE,  COMPUTE  POD.  THIS  IS  DIFFERENT  THAN  THE  GENERAL 
CASE  AS  D  AND  WR  CANNOT  BE  NORMALIZED. 

IF  (D.EQ.0.0)  GO  TO  20 
COMPUTE  Z 

Z  =  (1/BETA)  *  ALOG((WR*EX)/D) 

IF  Z  >  3.87  POD  =.999,  IF  Z  IS  CLOSE  TO  0,  POD  =.50 
IF  Z  <-3.87  POD  IS  0  FOR  ALL  PRACTICAL  PURPOSES. 

IF  (Z.GT.3.87)  GO  TO  20 
ZAB  =  ABS(Z) 


O  O  U  CJ  o  o  o 
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IF  (ZAB.LT.5.E-7)  GO  TO  30 
IF  (Z.LT.-3.87)  GO  TO  40 
C  POD  EQUALS  .5  +  .5  *  (ABS(Z)/Z)  *  ERF(Z) 

C  =  .70710678*ABS(Z) 

ERFU  =  1.-  1. /((I. +C*(. 0705230784  +C*( • 0422820123  +C*( .0092705272 
A  +C*(. 0001520143  +C*( .0002765672  +.0000430638*C))))))**16) 

SIGN  =  1. 

IF  (Z.LT.O.)  SIGN  =  -1. 

POV  =  .5  +  .5  *  SIGN  *  ERFU 
GO  TO  120 
20  POV  =  .999 
GO  TO  120 
30  POV  =  .500 
GO  TO  130 
40  POV  =  0.00 
GO  TO  130 
50  CONTINUE 

NORMALIZE  WR  AND  D. 

X  IS  THE  SYMBOL  USED  FOR  NORMALIZED  D 

WRN  =  1.1774  *  WR  /  ADCEP 
X  =  1.1774  *  D  /  ADCEP 

FSUM  WILL  SUM  TERMS  OF  GAUSSIAN  QUADRATURE 

FSUM  =0.0 
BMINSA  =  .0 

C  IF  DN-4  <  0  BEGIN  INTEGRATION  WITH  RADIUS  OF  ZERO,  OTHERWISE  AT  DN-4. 
C  SET  INTEGRATION  INTERVAL. 

XBB  =  1.06  *  WRN  *  EXP  (2.86  *  DSIG) 

XB  =  X  +  4.0 

IF  (XBB  .LT.  XB)  XB  =  XBB 
IF  (X  -4.0)  70,70,80 
70  XA  =  0.0 

BPLUSA  =  XB 

BMINSA  =  XB 

GO  TO  90 

80  XA  =  X  -  4.0 

BPLUSA  =  XA  +  XB 

BMINSA  =  XB  -  XA 

IF  (BMINSA. LE.O.)  GO  TO  110 
C 

C  COMPUTE  POD  THROUGH  LOOP  100 
C 

C  BEGINNING  OF  LOOP 

C 

90  WRNX=WRN*EX 
BETA 1=1. /BETA 
DO  100  N=l,5 

R1  =.5*  (-BMINSA  *  ZP(N)  +  BPLUSA) 
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R2  =.5*  (BMINSA  *  ZP(N)  +  BPLUSA) 

C  COMPUTE  Z'S,  UPPER  LIMITS  OF  INTEGRALS 
Z1  =  BETAI  *  (ALOG(WRNX/Rl)) 

Z2  =  BETAI  *  (AL0G(WRNX/R2)) 

CALL  INTGF4(Z1,R1,X,F) 

FSUM=FSUM+W(N)*F 
IF  (Z2.LT.-3.87)  GO  TO  100 
CALL  INTGF4(Z2,R2,X,F) 

FSUM=FSUM+W(N)*F 
100  CONTINUE 
C 

C  END  OF  LOOP 

C 

110  CONTINUE 

C 

C 

POV  =  .5*  FSUM  *  BMINSA 
120  CONTINUE 
C 

C  WE  NOW  HAVE  A  GOOD  POD 
C 

C  WHERE  DO  WE  GO  FROM  HERE?  FOR  D  GO  TO  140. 

IF  (IFLG.EQ.6)  GO  TO  140 
IF  (POV.LE. .99)  GO  TO  130 
IF  (IFLG.EQ.l)  POV=.99 
IF  (POV. GT. .999)  POV=.999 
130  POD  =  POV 

D  =  D  /  6076.1155 
RETURN 
C 

140  CONTINUE 
C 

C  THIS  IS  WHERE  COMPUTATION  OF  D,  OFFSET  DISTANCE,  OCCURS  IF  IT  IS 
C  DESIRED.  THIS  COMPUTES  THE  MAX  DISTANCE  AT  WHICH  A  GIVEN 
C  MINIMUM  POD  CAN  BE  OBTAINED. 

C 

C  SINCE  IN  THIS  CASE  POV  WAS  COMPUTED  WITH  D  =0,  IF  DESIRED  POD  >  POV, 
C  POD  IS  UNATTAINABLE. 

IF  (ITCH.GT.O)  GO  TO  150 
IF  (POV. LT. POD)  GO  TO  180 
ITCH  =  1 
ACC  =  .0005 
CROSS  =  .FALSE. 

DD  =  WR 
D  =  WR 
GO  TO  10 
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C 

C 

C**Vf*: 


LEVEL  OF  PD  BY  NO  MORE  THAN  .0005  WHICH,  WHEN  ROUNDED,  WILL  GIVE 
THE  USER  THE  DESIRED  LEVEL  OF  PD 


iV***Vi 


5V*Vf**Vf  Vf**iV**'!Wr*»V**********Vf»VVr**VfVf  Vf  ***?'?**  A>V*VnV 


IF  (POV  .GE.  POD  .AND.  PDA  .LT.  ACC)  GO  TO  170 
IF  (POD. GT. POV)  GO  TO  160 
IF  (CROSS)  DD  =  DD  *  .5 
D  =  D  +  DD 
GO  TO  10 

160  CROSS  =  .TRUE. 

DD  =  DD  *  .5 
D  =  D  -DD 
GO  TO  10 

170  D  =  D  /  6076.1155 

C 

C  HERE  IS  WHERE  CONTROL  IS  RETURNED  TO  MAIN  PROGRAM  FROM  OFFSET 

C  DISTANCE  COMPUTATION. 

C 


RETURN 

180  CONTINUE 
lERR  =  1 
D  =  0.0 
RETURN 
END 


C 

SUBROUTINE  INTGF4(Z,R,X,F) 
C 


C 

C  CALLED  FROM:  LNCAL4 

C  SUBROUTINES  CALLED:  NONE 

C  ERROR  FLAGS  SET:  NONE 

C 


RX=R*X 

IF  (RX.GT.3.75)  GO  TO  1 
TS=.071111111*(RX**2) 

F  =  (R*  EXP(-.5*(R**2  +  X**2)))*(1.+TS*(3.5156229+TS* 

A  (3. 0899424+TS*( 1.2067492  +  TS*(0 . 2659732  +TS*(0 . 0360768  + 
B  TS*0.0045813)))))) 

IF  (Z.LE.3.87)  GO  TO  2 
RETURN 

1  TI  =  3.75/RX 

F  =  .51639778  *  R  *  EXP(-.5*(X-R)**2)  *  SQRT(TI)  * 

A  ((((((((.00392377*TI  - . 01647633)*TI  +.02635537)  *  TI 
B  -  .02057706)*TI  +  . 00916281)*TI  -  .r'Jl57565)*TI 
C  +  .00225319)*TI  +  . 01328592)*TI  +  .39894228) 

IF  (Z.GT.3.87)  RETURN 

2  SIGN  =  1. 


IF  (Z.LT.O.)  SIGN  =  -1. 

U  =  .70710678  *  ABS(Z) 

F  =  F  *  (0.5  +  .5  *  SIGN  *  (  1.  -1./ 
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A((l.  +  U*(. 278393  +  U*(. 230389  +  U*(. 000972  +  U*. 078108) )))**4))) 
RETURN 
END 

FUNCTION  ACEP(CEP,A,B) 

ACEP=  SQRT(CEP**2  +  (1 . 1774*A*B)**2)/  1.1774 


RETURN 

END 

C******V?**iV***V:****Vf**-,V**' 

c 


•****5V**Vf*i'f**Vr*Vr****' 


:*5V>V?'c*iViV*****5V**>V**?V* 


SUBROUTINE*  ETCAL4  ( I V , JT , KF , YLD , CEP , HOB 1 , ORIEN , AZMTH , DI , POD , WR , 
A  lERR) 


QVf***Vf***VfVf**VfA**>'r**Vf*Vf**iV*iV*iVTV************Vt*')V: 


'**iV*A>V5ViViV5V***iV*>V*5V****Vr*>V 


C 

C  ETCAL4  CALCULATES  POD  FOR  EQUIVALENT  TARGET  AREA  TYPE  TARGETS. 

C  THESE  TGTS  INCLUDE  BRIDGES,  CANAL  LOCKS,  DAMS,  AND  A  SPECIAL  CASE. 
C 

C  CALLED  FROM:  MAIN 

C  SUBROUTINES  CALLED:  WRCAL4  WRCRT4 

C  ERROR  FLAGS  SET:  NONE 

C 

DIMENSION  INW(3,10,6),  CRW(  10,6),  DSWV(  10,6),  VNW(10,6), 
A  INL(6,10,6),  CRL(2,10,6),  DSLV(2,10,6),  VNL(10,6) 

C 

C  FUNCTIONS  ***** 

DD(B,C)  =  ABS(B)  /  (SQ2*C) 

C 

ER(B,C)  =  1.  +  DD(B,C)*(W1+DD(B,C)*(W2+DD(B,C)*(W3+DD(B,C)*(W4+ 
A  DD(B,C)*(W5+DD(B,C)*W6))))) 

C 

ERFP(B,C)  =  (1.  -  (l./ER(B,C))*’>16)  *  ABS(B)/(2.*B) 


**  POD  FUNCTION  ** 

P(B,C,D,E,F,G,H,A)  =  (ERFP(D,E)  -  ERFP(B,C))  * 
A  (ERFP(H,A)  -  ERFP(F,G)) 


APOLLO- 1 


**  DELIVERY  SIGMA  FUNCTION  ** 


ACEP(A,B)  =  SQRT(CEP**2  +  (1 . 1774*A*B)**2)/ 


1.1774 


C 

C 

C 

C 

C 

C 


DATA  INW  / 

INW(I,J,L)  CONTAINS  VNTK  VALUES  TARGET  WIDTHS  IF  THEY  EXIST. 

1=1  IS  VN,  1=2  IS  T,  1=3  IS  K.  J=KF+1.  L=l,2,3  IS  FOR  BRIDGES, 
K=4  IS  FOR  DAMS,  L=5  IS  FOR  LOCKS,  L=6  IS  FOR  SPECIAL  CASE. 


A  0,0,0, 
B  15,2,9, 


BRIDGES 

0,0,0,  0,0,0,  31,1,0,  25,2,6,  20,2,6,  18,2,6,  25,2,8, 

16,2,8,  0,0,0,  18,2,9,  17,2,9,  16,2,8,  15,2,9,  17,2,8, 
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C14,2,9,  16,2,9,  16,2,9,  0,0,0,  * 

018,2,9,  17,2,9,  16,2,8,  15,2,9,  16,2,9,  17,2,8,  17,2,8,  9*0, 

C  DAMS  (UPSTREAM  VNTK) 

E  41,1,0,  38,1,0,  38,1,0,  42,1,0,  39,1,0,  39,1,0,  39,1,0,  35,1,0, 

F  35,1,0,  0,0,0, 

C  LOCKS 

G  30  *  0, 

C  SPECIAL  CASE 

H  3*0,  13,2,5,  11,2,4,  21*0/ 

C 

DATA  CRW  / 

CRW(J,L)  CONTAINS  CRATER  RADIUS  FACTOR  FOR  WIDTH  TGTS  IF  IT  EXISTS. 


A  1.5,  2.0,  1.5, 
C  9*.0,  1.0, 

D  1.0,  1.5,  1.0, 
E  10*. 0/ 


DRIDGES 
27*. 0, 

DAMS  (UPSTREAM  CRF) 
LOCKS 

1.5,  1.0,  1.5,  4*.0, 
SPECIAL  CASE 


DATA  INI 


INL(I.J.L)  CONTAINS  LENGTH  VNTK  FOR  ETA  TGT  FOR  BOTH  FRONT  AND  BACK. 
SUBSCRTK  .AVE  MEANINGS  SIMILAR  TO  INW. 


BRIDGES 

A  18*0,  38,1,0,0,0,0,  29,2,6  0,0,0,  23,2,6,0,0,0,  21,2,6,0,0,0, 

B  29,2,8,0,0,0,  18,2,9,0,0,0,  22,2,8,  9*0,  22,2,9,0,0,0,20,2,9, 

2  0,0,0,  19,2,8, 

C  0,0,0,  21,2,7,0,0,0,  23,2,8,0,0,0,  23,2,7,0,0,0,  25,2,8,0,0,0, 

D  25,2,8.  9*0, 

E  22,2,8,3*0,  22,2,8,3*0,  22,2,8,3*0,  23,2,7,3*0, 

3  25,2,8,3*0,  23,2,7,3*0,  25,2,8,  21*0, 

DAMS  (DOW.NSTREAM  VNTK) 

F  60  *  0, 

LOCKS 

G  12*0,  31,1,4*0,  31,1,4*0,  31,1,0,  31,1,0,  31,1,0,  31,1,25*0, 
SPECIAL  CASE 

H  6*0,  13,2,5,  3*0,  11,2,4,  45*0/ 


DATA  CRL  / 

CRL(I,J,L)  CONTAINS  FRO.NT  AND  REAR  CRF'S  FOR  ETA  TGTS 

BRIDGES 

A  1.25,0. ,  1.5, .0,  1.25,.0,  34*. 0, 

B  20*. 0, 


C 


DANS  (DOWNSTREAM  CRF) 
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C 

C 

C 


C  .5,.0,  .5,  .0,  .5,.0,  .5,.0,  .5,.0,,5,.0,  .5,.0,  .5,.0,  .5,.0, 
3  1.5,  .0, 

LOCKS 

D  2*1.0,  2*1.5,  .0,1.0,  .0,1.5,  12*. 0, 

SPECIAL  CASE 

E  20*. 0/ 


DATA 


DSWV 


/ 


DSWV(J,K)  CONTAINS  WIDTH  DAMAGE  SIGMAS 
BRIDGES 

A  3*. 3,  .2,  6*.3,.0,  8*. 3,  .0, 

B  7*. 3,  3*.0, 

DAMS  (UPSTREAM  DSIG) 

C  9*. 2,  .3, 

LOCKS 

D  6*. 3,  4*.0, 

SPECIAL  CASE 
E  .0,  .3,  .3,  7*.0/ 


DATA  DSLV 


/ 


DSLV(I,J,L)  CONTAINS  LENGTH  DAMAGE  SIGMAS  AND  DOWNSTREAM  DSIG'S 

BRIDGES 

A  .3, .0, .3, .0, .3, .0,  .2,.0,.3,.0,.3,.0,.3,.0,.3,.0,.3,.0,.3,.0, 

1  .0,.0,  .3, .0, .3, .0, .3, .0, .3, .0, .3, .0, .3, .0, .3, .0, .3, .0,  .0,.0, 
B  .3,.0,.3,.0,.3,.0,.3,.0,.3,.0,.3,.0,.3,7*.0, 

DAMS  (W/DOWNSTREAM  DSIG'S) 

C  .0,.3,.0,.3,.0,.3,.0,.3,.0,.3,.0,.3,.0,.3,.0,.3,.0,.3,.0,.3, 

LOCKS 

D  4*.3,  .2, .3,  .2, .3,  4*. 2,  8*.0, 

SPECIAL  CASE 

E  2*.0,  .3,.0,  .3,.0,  14*. 0/ 


C 

C 

C 

C 


DATA  VNW  / 

VNW(J,L)  CONTAINS  WIDTH  DIMENSIONS. 

BRIDGES 


A  5., 

15. 

,  25. 

,  35.,  45., 

55.,  65.,  75., 

85.  ,  90 

A  5., 

15. 

,  25. 

.  35.,  45., 

55. ,  65. ,  75. , 

85.,  90 

A  5., 

15. 

,  25. 

,  35.,  45., 

55.,  65.,  75., 

85.  ,  90 

c 

B  5., 

15. 

,  26. 

DAMS 

,  40.,  57., 

82.,  114.,  163, 

.  .  229.. 

LOCKS 

C  33.,  40.,  60.,  75.,  90. ,110.,  125.,  145.,  180.,  200., 
SPECIAL  CASE 

D  2000. ,1900. ,1700. ,1500. ,1300. ,1100. ,900 . , 700 . ,500 . , 300. / 


DATA 


VNL 


/ 
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VNL(J.L)  CONTAINS  LENGTH  DIMENSIONS. 

BRIDGES 

A  50. ,150. ,400. ,800. ,1200. ,1600. ,2000. ,2400. ,2800. ,3000. , 

A  50. ,150. ,400. ,800. ,1200. ,1600. ,2000. ,2400. ,2800. ,3000. , 

A  50. ,150. ,400. ,800. ,1200. ,1600. ,2000. ,2400. ,2800. ,3000. , 

DAMS 

B  500. ,750. ,1500. ,2500. ,3500. ,4500 ., 7500 ., 12500 . ,20000. ,25750. , 
LOCKS 

C  98., 130.,  250.,  500. ,800. ,1300. ,2000. ,  2450.,  2800.,  3000., 
SPECIAL  CASE 

D  10000. ,9500. ,8500. ,7500. ,6500. ,5500. ,4500. ,3500. ,2500. ,2000./ 

DATA  Wl,  W2,  W3,  W4,  W5,  W6  / 

WI'S  ARE  THE  CONSTANTS  FOR  THE  ERROR  FUNCTION  APPROXIMATION 
A  .0705230784, .0422820123,. 0092705272, .0001520143, .0002765672, 

B  .0000430638/ 

IFLG  =  8 


SET  CONSTANTS  AND  INITIALIZE  VARIABLES. 

SQ2  =  SQRT  (2.) 

IGV  =  IV/ 10 

IGN  =  IV  -  (IGV*10) 

WRLl  =  .0 
WRL2  =  .0 
WRWl  =  .0 
KK  =  KF  +1 

CHECK  DIMENSION  SUBSCRIPTS 
IF  (IGN.EQ.O)IGN  =  10 
IF  (IGV  .F.Q.  0)  IGV  =10 

DECODE  JT 

JTS=JT 

GO  TO  (100,110,110,300,200,400),  JTS 
****  bridge  SECTION  **** 

JTS  TO  1  OR  2  OR  3  FOR  BRIDGES 

IF  AIR-BURST  FOR  AO,  Al,  OR  A2  TYPE  BRIDGES,  SET  POD  TO  ZERO. 

100  IF  ((KF.LT.3).AND.(H0B1.GT..99))  GOTO  500 
DETERMINE  WEAPON  RADII 

SEE  IF  CRATER  OR  NON-CRATER 

no  IF  (CRL(l,KK,JTS).GT.O)  CALL  WRCRT4(YLD,CRL(1 ,KK, JTS) , WRLl , JTS, KF) 
IF  (INL(2,KK,JTS).GT.O)  CALL  WRCAL4  (YLD ,H0B1 , INL( 1 ,KK, JTS) , 

A  INL(2,KK,JTS),  INL(3 ,KK, JTS) ,DSLV( 1 ,KK , JTS) , WRLl , IFLG, lERR) 

C 

IF  (CRW(KK,JTS).GT.O)  CALL  WRCRT4  (YLD,CRW(KK, JTS) , WRWl , JTS, KF) 

IF  (INW'(2.KK,JTS).GT.O)  CALL  WRCAL4(YLD,H0B1 , INW( 1 ,KK , JTS) , 
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c 

c 

c 

c 

c 

c 

c 


c 

c 

c 


c 


c 

c 

c 


c 


A  INW(2,KK,JTS),INW(3,KK,JTS),DSWV(  KK.JTS) ,WRW1,IFLG,IERR) 


DETERMINE  X  AND  Y  OFFSET  DISTANCES 
ORIEN  IS  TARGET  ORIENTATION 
AZMTH  IS  AZIMUTH  FROM  DGZ  TO  TARGET 
XO  IS  THE  EAST-WEST  COMPONENT 
YO  IS  THE  NORTH -SOUTH  COMPONENT 
DDUM  =  DI  *  6076.1155 

ANGLE  =  (AZMTH  -  ORIEN  *  10.)  /  57.295779 
XO  =  DDUM  *  SIN(ANGLE) 

YO  =  DDUM  *  COS (ANGLE) 

COMPUTE  BOUNDARIES 

W  =  VNW(IGN,JTS) 

SL=  VNL(IGV,JTS) 

A  =  -W/2.  -  WRWl  +  XO 
B  =  W/2.  +  WRWl  +  XO 
C  =  -SL/2.  -  WRLl  +  YO 
D  =  SL/2.  +  WRLl  +  YO 

COMPUTE  DELIVERY  SIGMAS 

AA  =  ACEP(CEP,WRW1,  DSWV(KK, JTS)) 

AB  =  AA 

AC  =  ACEP(CEP,WRL1,  DSLV(1,KK,JTS)) 

AD  =  AC 


**  COMPUTE  POD  ** 

V*Vf*Vf5'fiV***-.'.--.'f*V.-*5VVf*-.V***>V**Vf*A****-,VVf********i'fiVrt  .f***lV**lV****i'f* 


**  IF  the  DISTANCE  FROM  THE  DGZ  TO  THE  EDGE  OF  THE  EQUIVALENT  ** 
**  TARGET  AREA  (WHERE  ANY  PD  CAN  BE  ACHIEVED)  IS  GREATER  THAN  ** 
C  **  3.5  *  CEP,  PD  IS  ZERO.  (REF  DIA  AP-550,  PG  IV-26)  ** 


.U  -}f 


CSDG  4  LINES  LIKE  THE  FOLLOWING  CHANGED  PER  TELECON  JCS(J-8)  15  JUL  87 
CSDG  MXOFFL  =  DDUM  -  (L/2  +  WRLl) 

MXOFFL  =  DDUM  -  (SL/2  +  WRLl) 

MXOFFW  =  DDUM  -  (W/2  +  WRWl) 

CEP35  =  CEP  *  3.5 

IF  (MXOFFL  .GT.  CEP35  .AND.  MXOFFW  .GT.  CEP35)  GO  TO  500 


POD  =  P(A,AA,B,AB,C,AC,D,AD) 
RETURN 


C 

C 

C 

C 


LOCK  SECTION 
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C  IF  AIR-BURST  SET  POD  TO  ZERO 

200  IF  (HOBl  .GT.  .001)  GO  TO  500 

DETERMINE  WEAPON  RADII 

SEE  IF  CRATER  OR  NOT  AND  COMPUTE  WR'S  ACCORDINGLY 

IF  (CRL(l,KK,JTS).GT.O)  CALL  WRCRT4(YLD,CRL(1,KK,JTS) ,WRL1,JTS,KF) 
IF  (INL(2,KK,JTS).GT.O)  CALL  WRCAL4  (YLD.HOBl , INL(1 ,KK, JTS) , 

A  INL(2,KK,JTS),  INL(3 ,KK, JTS) ,DSLV(1 ,KK, JTS) ,WRL1 , IFLG, lERR) 

IF  (CRL(2,KK,JTS).GT.O)  CALL  WRCRT4(YLD,CRL(2,KK,JTS) ,WRL2,JTS,KF) 
IF  (INL(5,KK,JTS).GT.O)  CALL  WRCAL4  (YLD, HOBl, INL(4,KK, JTS) , 

A  INL(5,KK,JTS),  INL(6,KK,JTS) ,DSLV(1,KK,JTS) ,WRL2,I1'LG,IERR) 

IF  (CRW(KK,JTS).GT.O)  CRW(KK,JTS)=-CRW(KK, JTS) 

IF  (CRW(KK,JTS).LT.O)  CALL  WRCRT4  (YLD,CRW(KK,JTS) ,WRW1,JTS,KF) 

IF  (INW(2,KK,JTS).GT.O)  CALL  WRCAL4(YLD, HOBl , INW(1 ,KK, JTS) , 

A  INW(2,KK,JTS),INW(3,KK,JTS),DSWV(  KK, JTS) ,WRW1 , IFLG, lERR) 

WR  =  (WRL2-WRLl)/2.0 

IF  (INL(2,KK,JTS).GT.O)  WR=(WRLl-WRL2)/2.0 

DETERMINE  X  AND  Y  OFFSET  DISTANCES 
ORIEN  IS  TARGET  ORIENTATION 
AZMTH  IS  AZIMUTH  FROM  DGZ  TO  TARGET 
XO  IS  THE  EAST-WEST  COMPONENT 
YO  IS  THE  NORTH-SOUTH  COMPONENT 
DDUM  =  DI  *  6076.1155 
ANGLE  =  (AZMTH  -  ORIEN  *  10.)  /  57.295779 
XO  =  DDUM  *  SIN (ANGLE) 

YO  =  DDUM  *  COS (ANGLE) 

C  COMPUTE  BOUNDARIES  AND  DELIVERY  SIGMAS 

W  =  VNW  (IGN,JTS) 

SL='  VNL  (IGV,JTS) 

C 

A  =  -W/2.  -  WRWl  +  XO 

B  =  W/2.  +  WRWl  +XO 

AA  =  ACEP(CEP, WRWl, DSWV(KK, JTS)) 

AB  =  AA 
C 

IF  (INL(2,KK,JTS).GT.O)  GO  TO  210 
C  =  -SL/2.  -WRLl  +YO 
D  =  SL/2.  +WRL2  +YO 
AC  =  ACEP(CEP, WRLl, DSLV(1,KK, JTS)) 

AD  =  ACEP(CEP,WRL2,DSLV(2,KK,JTS)) 

GO  TO  220 
C 

210  CONTINUE 

C  =  -SL/2.  -WRL2  +  YO 
D  =  SL/2.  +WRL1  +  YO 
AC  =  ACEP(CEP,WRL2,DSLV(2,KK,JTS)) 

AD  =  ACEP(CEP, WRLl, DSLV(1,KK, JTS)) 
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C 

220 


C 

C 


CONTINUE 


*  COMPUTE  POD  * 


*********** 


**  IF  THE  DISTANCE  FROM  THE  DGZ  TO  THE  EDGE  OF  THE  EQUIVALENT  ** 
**  TARGET  AREA  (WHERE  ANY  PD  CAN  BE  ACHIEVED)  IS  GREATER  THAN  ** 
**  3.5  *  CEP,  PD  IS  ZERO.  (REF  DIA  AP-550,  PG  IV-26)  ** 


MXOFFL  =  AMAX1(WRL2,WRL1) 

MXOFFL  =  DDUM  -  (L/2  +  MXOFFL) 

MXOFFL  =  DDUM  -  (SL/2  +  MXOFFL) 

MXOFFW  =  DDUM  -  (W/2  +  WRWl) 

CEP35  =  CEP  *  3.5 

IF  (MXOFFL  .GT.  CEP35  .AND.  MXOFFW  .GT.  CEP35)  GO  TO  500 


POD  =  P(A,AA,B,AB,C,AC,D,AD) 
RETURN 


****  dam  SECTION  **** 
JTS  =  4  FOR  DAMS 


IF  AIR-BURST  SET  POD  TO  ZERO 
300  IF  (HOBl  .GT.  .001)  GO  TO  500 

DETERMINE  WEAPON  RADII 

IF  (CRL(l,KK,JTS).GT.O)  CRL(1,KK,JTS)=-CRL(1,KK,JTS) 

IF  (CRL(l,KK,JTS).LT.O)  CALL  WRCRT4(YLD,CRL(1,KK,JTS) ,WRL1,JTS,KF) 
IF  (INL(2,KK,JTS).GT.O)  CALL  WRCAL4  (YLD, HOBl , INL(1 ,KK, JTS) , 

A  INL(2,KK,JTS),  INL(3,KK, JTS) ,DSLV( 1 ,KK, JTS) ,WRL1 , IFLG , lERR) 

IF  (CRW(KK,JTS).GT.O)  CALL  WRCRT4  (YLD, CRW(KK, JTS) , WRWl, JTS, KF) 

IF  (INW(2,KK,JTS) .GT.O)  CALL  WRCAL4(YLD,H0B1 , INW(1 ,KK, JTS) , 

A  INW(2,KK,JTS),INW(3,KK,JTS),DSWV(  KK, JTS) , WRWl , IFLG, lERR) 

C 

WR-(WRWl-WRLl)/2.0 

C 

C  DETERMINE  X  AND  Y  OFFSET  DISTANCES 

C  ORIEN  IS  TARGET  ORIENTAION 

C  AZ.MTH  IS  AZIMUTH  FROM  DGZ  TO  TARGET 

C  XO  IS  THE  EAST-WEST  COMPONENT 

C  YO  IS  THE  NORTH -SOUTH  COMPONENT 

DDUM  =  DI  *  6076.1155 

ANGLE  =  (AZMTH  -  ORIEN  *  10.)  /  57.295779 
XO  =  DDUM  *  SIN(ANGLE) 

YO  =  DDUM  *  COS (ANGLE) 

C 

C  COMPUTE  BOUNDARIES 

W  =  VNW’  (IGN,JTS) 


o  o  o  o 
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SL=  VNL  (IGV.JTS) 

C  =  -SL/2.  +Y0 
D  =  SL/2.  +Y0 

IF  (KF.EQ.9)  GO  TO  310 
A  =  -WRWl  -.10  +  XO 
B  =  WRLl  -.10  +  XO 
GO  TO  320 

)  CONTINUE 

A  =  -WRWl  +W/2.  +  XO 
B  =  WRLl  -W/2.  +  XO 

)  CONTINUE 

COMPUTE  DELIVERY  SIGMAS 
AA  =  ACEP(CEP,WRW1,DSWV(KK,JTS)) 

AB  =  ACEP(CEP,WRL1,DSLV(2,KK,JTS)) 

AC  =  ACEP  (CEP, SL/2. ,DSLV(1,KK,JTS)) 

AD  =  AC 

*  COMPUTE  POD  * 

**  IF  THE  DISTANCE  FROM  THE  DGZ  TO  THE  EDGE  OF  THE  EQUIVALENT  ** 
**  TARGET  AREA  (WHERE  ANY  PD  CAN  BE  ACHIEVED)  IS  GREATER  THAN  ** 
**  3.5  *  CEP,  PD  IS  ZERO.  (REF  DIA  AP-550,  PG  IV-26)  ** 

VfVf**Vf****Vr'>V**Vf*5V***-.ViV****iln!fVt***»VVf**i'r**Vf*****-.'r*V:***iV*****iViV*i'r5VAVf>'f 

3  MXOFFL  =  DDUM  -  (L/2  +  WRLl) 

MXOFFL  =  DDUM  -  (SL/2  +  WRLl) 

MXOFFW  =  DDUM  -  (W/2  +  WRWl) 

CEP35  =  CEP  *  3.5 

IF  (MXOFFL  .GT.  CEP35  .AND.  MXOFFW  .GT.  CEP35)  GO  TO  500 


POD  =  P(A,AA,B,AB,C,AC,D,AD) 

IF  POD  IS  NEGATIVE,  SET  IT  TO  ZERO  AND  RETURN. 
IF  (POD.LT.O)  GO  TO  500 

RETURN 


***  SPECIAL  CASE  SECTION 


DETERMINE  WEAPON  RADIUS 

CALL  WRCAL4 ( YLD , HOB  1 , INL ( 1 , KK , JTS ) , INL ( 2 , KK , JTS ) , INL ( 3 , KK , JTS ) , 
A  DSLV(1,KK, JTS), WRLl, IFLG,IERR) 

WRW1=WRL1 


DETERMINE  X  AND  Y  OFFSET  DISTANCES 
ORIEN  IS  TARGET  ORIENTAION 
AZMTH  IS  AZIMUTH  FROM  DGZ  TO  TARGET 
XO  IS  THE  EAST-WEST  COMPONENT 
YO  IS  THE  NORTH-SOUTH  COMPONENT 


o  o 
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DDUM'=  DI  *  6076.1155 

ANGLE  =  (AZMTH  -  ORIEN  *  10.)  /  57.295779 
XO  =  DDUM  *  SIN (ANGLE) 

YO  =  DDUM  *  COS (ANGLE) 

C 

C  COMPUTE  BOUNDARIES 

W  =  VNW  (IGN.JTS) 

SL=  VNL  (IGV.JTS) 

C 

A  =  -W/2.  -WRWl  +  XO 
B  =  W/2.  +WRW1  +  XO 
C  =  -SL/2.  -WRLl  +  YO 
D  =  SL/2.  +WRL1  +YO 

C 

C  COMPUTE  DELIVERY  SIGMAS 

C 


AA  =  ACEP(CEP,WRW1,DSWV(KK,JTS)) 

AB  =  AA 

AC  =  ACEP(CEP,WRW1,DSLV(1,KK,JTS)) 
AD  =AC 


C 

C  **  COMPUTE  POD  ** 

C  **  IF  THE  DISTANCE  FROM  THE  DGZ  TO  THE  EDGE  OF  THE  EQUIVALENT  ** 
C  **  TARGET  AREA  (WHERE  ANY  PD  CAN  BE  ACHIEVED)  IS  GREATER  THAN  ** 
C  **  3.5  *  CEP,  PD  IS  ZERO.  (REF  DIA  AP-550,  PG  IV-26)  ** 

C  **Vf*Vf**5V*5'nVVf****;MrAVr*Vf***A****iV****>’f*iVVr***i’nV******iV*VnV*******>’fiV>V 

CSDG  MXOFFL  =  DDUM  -  (L/2  +  WRLl) 

MXOFFL  =  DDUM  -  (SL/2  +  WRLl) 

MXOFFW  =  DDUM  -  (W/2  +  WRWl) 

CEP35  =  CEP  *  3.5 

IF  (MXOFFL  .GT.  CEP35  .AND.  MXOFFW  .GT.  CEP35)  GO  TO  500 


C 

C 


POD  =  P(A,AA,B,AB,C,AC,D,AD) 


RETURN 


500  POD  =  .0 


RETURN 

END 


SUBROUTINE  WRCRT4  (YLD,CRF,WR, JTS.KF) 


c 

C  CALLED  FROM:  ETCAL4 

C  SUBROUTINES  CALLED;  NONE 

C  ERROR  FLAGS  SET:  NONE 

C 
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VAl=1.2E+4 
ALPHA=0 . 323 

IF  (JTS.EQ.4.AND.KF.EQ.9.AND.CRF.GT.0)  GO  TO  1000 
IF  (JTS.EQ.5.AND.CRF.GT.0)  GO  TO  2000 
IF  (JTS.EQ. 4. AND.KF.lt. 9)  GO  TO  3000 
GO  TO  4000 
1000  VAl=1.0E+5 
ALPHA=0.294 
GO  TO  4000 
2000  VAl=2.0E+5 
ALPHA=0.294 
GO  TO  4000 
3000  VAl=2.5E+4 
ALPHA=0 . 294 
4000  CONTINUE 

IF  (CRF.LT.O)  CRF=-CRF 
VA=V A 1 * ( Y  LD ) ** ( 3* ALPHA ) 

RA=1.2*((VA)**(l./3.)) 

WR  =  1.1  *  CRF  *  RA 

RETURN 

END 


OOOO  O  OO 
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SUBROUTINE  PDEXEC(IV,  JT.KFACT.YLD.HOBI  ,R95NM,CEP,0FFNM,WR,P, 

2  IFLGC,IERR,AZMTH) 

C  THIS  ROUTINE  IS  AN  EXECUTIVE  SUBROUTINE  WHICH  SUPERVISES 
C  CALLS  TO  PDCALC.  IT  HAS  THE  SAME  ARGUMENTS  AS  PDCLC4. 

C  PDEXEC  WAS  DEVELOPED  BY 

C  THE  STONEHOUSE  GROUP,  INC.  (303)  850-9851 

C  THIS  ROUTINE  HAS  BEEN  RELEASED  TO  THE  PUBLIC  DOMAIN 
C 

C  THIS  ROUTINE  FINDS  PK  OR  OFFSET  AT  SPECIFIED  OR  OPTIMAL  HOB 

C  USING  PDCALC.  START  AT  SHOB=0  AND  INCREMENT  100  FEET  TIL  PK  OR  OFFSET  DEC 

C  THEN  BREAK  OUT  HOB  INTERVAL  WHICH  SPANS  MAXIMUM  INTO  10  SUBSTEPS 
C  CONTINUE  THIS  PROCESS  4  TIMES  TOTAL.  FORLMNOPVWXYZ 
C  AND  Q  R  S  T  U  V  TYPE  TARGETS  INCREMENT  AT  SAME  INTERVALS 
C  USED  IN  WRCAL4. 

C 

C  IV.JT.KFACT  ARE  VNTK  --  JT  IS  UPPER  CASE  FOR  UPPERCASE  SOURCE 
C  LOWER  CASE  FOR  LOWERCASE  SOURCE 

C  R95NM  IS  TARGET  RADIUS  IN  NM 
C  AZMTH  IS  AZIMUTH  PASSED  TO  AND  FROM  PDCALC 
C  P  IS  RETURNED  PK  AT  OPTIMUM  HOB  IF  IFLGC=1  OR  2 

C  P  IS  USER  DESIRED  PK  AT  OFFSET  IF  IFLGC=6 

C  OFFNM  IS  DISTANCE  FROM  AIMPOINT  TO  TARGET  IF  IFLGC=1  OR  2 

C  OFFNM  IS  CALCULATED  OFFSET  AT  OPTIMUM  HOB  IF  IFLGC=6 

C  IFLGC  ARE  FLAGS  BEING  PASSED  TO  PDCALC  BY  USER 

C  lERR  IS  RETURNED  ERROR  FLAG 

C  HOBI=-l.  CAUSES  'OPTIMUM  HOB'  TO  BE  FOUND  AND  RETURNED 
DATA  KV,KW,KX,KY,KZ,KH  /IHV, IHW, IHX, IHY, IHZ, IHH/ 

DATA  KA,KB,KC,KD,KE,KF  /IHA, IHB, IHC, IHD, IHE, IHF/ 

IETA=0 

C  IF  HOBI.NE.-l.  JUST  CALL  PDCALC 

IF(HOBI.NE.-l.)GO  TO  11 

IF  CRATER  REQUIRED  SET  HOB I  TO  0,  CALL  PDCALC  AND  RETURN 

FOR  P-TYPES  REQUIRING  CONTACT  BURST 
IF(JT.EQ.KV.OR.JT.EQ.K\s'.OR. 

1  JT.EQ.KX.OR.JT.EQ.KY.OR.JT.EQ.KZ)GO  TO  10 
FOR  PVDS 

IF(JT.EQ.KH.AND.IV.NE.3)G0  TO  10 
GO  TO  20 
0  HOBI=0. 

1  KFX=KFACT 

IFLGC 2= IFLGC 

CALL  PDCLC4 ( I V , JT , KFX , YLD , HOBI , R95NM , CEP . OFFNM , WR , P , IFLGC2 , lERR , 

1  AZMTH) 

RETURN 

INITIALIZE  FOR  ITERATIVE  SEARCH 
C 

C  IF  ITS  A  P  OR  Q  GET  HOB  FAST  CALLING  HB0PT4 

20  KFX=KFACT 
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CALL  HB0PT4 ( I V , JT , KFX , YLD , HOB I , I ERR ) 

IF(IERR.EQ.9)GO  TO  29 
IF(ILRR.EQ.6)RETURN 

C  TURN  OFF  WARNING  MESSAGES  IN  PDCALC  BY  ADDING  100 
IFLGC2=IFLGC 

IF(IFLGC.LT.100)IFLGC2=IFLGC+100 

HOBSAV=HOBI 

GO  TO  180 

29  STEP=99 . 887*YLD** . 33333333 
START=0 . 

ITS=0 

C  ITCT=0 

HOBSAV=0. 

30  XSAVE=0 . 

Hl=-1. 

H2=-l. 

H3=-l. 

Xl=-1. 

X2=-l. 

X3=-l. 

C  SPECIAL  LOGIC  IF  WANT  OFFSET  FOR  ETA  TARGET 

IF(JT.NE.KA.AND.JT.NE.KB.AND.JT.NE.KC.AND.JT.NE.KD.AND.JT.NE.KE) 
1  GO  TO  31 

SET  I ETA  TO  2  IF  WANT  PK  AND  HOB 
IETA=2 

SET  I ETA  TO  1  IF  WANT  OFFNM  AND  HOB 
IF( IFLGC . EQ . 6 . OR . IFLGC . EQ . 106) IETA=1 

START  ITERATIVE  SEARCH  FOR  OPTIMUM  HOB 


C 

C 

C 

C 

C 

31 


DO  150  IT=1,10 
ITSAV=IT 

HOB I=START+STEP*FLOAT( IT- 1 ) 

IFLGC2=IFLGC 

C  TURN  OFF  WARNING  MESSAGES  IN  PDCALC  BY  ADDING  100 
IF( IFLGC . LT. 100) IFLGC2=IFLGC+100 
KFX=KFACT 

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
IF(IFLGC.NE.6.AND.IFLGC.NE.106)G0  TO  130 
IF(IETA.NE.1)G0  TO  130 
FEASIBILITY  TEST  AT  OFFSET  =  ZERO 
0FF=0 . 

OFFFT1=0. 

IFLGC2=102 
WR=0 . 

CALL  PDCLC4 ( I V , JT , KFX , YLD , HOB I , R95NM , CEP , OFF , WR , PO , I FLGC2 , lERR , 
1  AZMTH) 

C  WR ITE ( 6 , 60 ) 1 , HOB I , OFF , PO , WR , I ERR 

IF((IERR.GE.1.AND.IERR.LE.3).0R.IERR.EQ. lO.OR. lERR.EQ. 12) 


C 

40 


C* 
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C 


C 

C 

C 

50 


C**v.- 


1  P0=0. 

IF((IERR.GE.l.AND.IERR.LE.3).OR.IERR.EQ.10.OR.IERR.EQ.12) 
1  OFF=-l. 

IF(OFF.NE.-l. .AND.IERR.NE,0)G0  TO  110 
IF(PO.GE.P)GO  TO  50 
CAN'T  GET  MINDE 
0FFNM=0 . 

GO  TO  140 


ITERATE  TILL  EXCEED  MAX  OFFSET 


DO  70  1=1,10 

0FFFT2=10**(I-1) 

0FF=0FFFT2/6076.115 


rAjVVfVriV*** 


c*' 


CALL  PDCLC4 ( IV , JT , KFX , YLD , HOB I , R95NM , CEP , OFF , WR , P2 , IFLGC2 , lERR , 
1  AZMTH) 


f.V**Vf*V:**iV***iViV**Vr*i'r*A****AiViV 


C  WRITE ( 6 , 60 ) 2 , HOBI , OFF , P2 , WR , lERR 

C60  FORMATC  I,HOBI,OFF,P,WR=',I5,4F10.2,'  IERR=',I4) 

IF((IERR.GE.1.AND.IERR.LE.3).OR.IERR.EQ.10.0R.IERR.EQ.12) 
1  P2=0. 

IF ( ( lERR . GE . 1 . AND . lERR . LE . 3) . OR . lERR . EQ . 10 . OR . lERR . EQ . 12 ) 
1  0FF=-1. 

IF(0FF.NE.-1. .AND.IERR.NE.O)GO  TO  110 
IF(P2.LT.P)G0  TO  80 
70  CONTINUE 
GO  TO  110 
C 


C  KEEP  HALVING  INTERVAL  TILL  GET  TO  WITHIN  2  FEET 
C 

C  OFFFTO  IS  CURRENT  MIN,  0FFFT2  IS  CURRENT  MAX 

80  0FFFT0=0 . 

90  OFFFTl=(OFFFTO+OFFFT2)/2. 

0FF=0FFFT1/6076.115 

Q^VV«  VrV«  V*  >V<V<VV>  •V<V«'tV»  ‘V'V'o  tV'M  Vf 'V**?  <VV*  ;V<V«VV»VrV»V»  «V«V*V’«‘rfV  V»V»^«V*V>V>V'*V>'rfV>V^^V^V*V>V'iV«'^'s'r 


C*' 

C 


CALL  PDCLC4 ( I V , JT , KFX . YLD . HOBI , R95NM , CEP , OFF . WR , P 1 , IFLGC2 , lERR , 
1  AZMTH) 

V»V»Vf«V»V'j'?VfV?V»«»V*'»VV*V»*VV»V»V»V»V»«V^V^‘»«VV*V*>V»V«V#V»'f?V  >V’»V**'.V»V*’»»Vv‘**VV'**V#V****'f»V’*’**********'****“V*V*‘“ 

WRITE(6,60)3,HOBI,OFF,P1,WR,IERR 

IF((IERR.GE.1.AND.IERR.LE.3).0R.IERR.EQ.10.0R.IERR.EQ.12) 

1  P1=0. 


IF((IERR.GE.l.AND.IERR.LE.3).OR.IERR.EQ.10.OR.IERR.EQ.12) 
1  OFF=-l. 


IF(OFF.NE.-l. .AND.IERR.NE.O)GO  TO  110 
IF(P1.GT.P)G0  TO  100 

C  PI  IS  NOT  ENOUGH  SO  NEED  LESS  OFFSET 
IF(OFFFT2-OFFFTl.LT.2.)GO  TO  120 
OFFFT2=OFFFTl 
GO  TO  90 

C  PI  TOO  MUCH  SO  NEED  MORE  OFFSET 


100  IF(0FFFT2-0FFFT1.LT.2.)G0  TO  120 
OFFFTO=OFFFT1 
GO  TO  90 
C 

C  ERROR  FINDING  ETA  OFFSET 

C 

no  0FFNM=0. 

IERR=99 

RETURN 

C 

C  FOUND  ETA  OFFSET 

C 

120  OFFNM=OFFFT1/6076.115 

C 

C  WE  HAVE  FOUND  THE  OFFSET 

C 

GO  TO  140 

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 

1 30  CALL  PDCLC4 ( I V , JT , KFX . YLD . HOBI , R95NM , CEP , OFFNM , WR , P , IFLGC2 , lERR , 

1  AZMTH) 

C>'f.V********Vf*VfVfA***»VVf*V?*Vr***Vr**VnViV**')V*iV*iV**i'r*iV>V*Vf*5'f*iV*‘.V*******-.V‘i'rVf****iV5'f 

140  X=WR 

IF(IETA.EQ.2)X=P 
IF(IETA.EQ.1)X=0FFNM 
C  KEEP  TRACK  OF  LAST  3  HOBS  AND  WRS 
H3=H2 
H2=H1 
H1=H0BI 
X3=X2 
X2=X1 
X1=X 

C  NEXT  4  LINES  FOR  DEBUG: 

C  ITCT=ITCT+1 

C  WR ITE ( 6 , 7  7  7 )  rrCT , HOB I .OFFNM , P , WR 

C777  FORMATC  test//', 12,'  HOB=' ,F10. 3,  '  OFFSET=' ,F10.3, 

C  1  '  PK=',F10.6,'  WR=',F10.2) 

C  IF  PK  OR  OFFSET  =  0  WE  HAVE  GONE  TOO  HIGH  OR  IF  HOB=0, 

C  THEN  THERE  IS  NO  SOLUTION 
IF(X.EQ.O.)GO  TO  160 

C  IF  PK  OR  OFFSET  HAS  DECREASED  ASSUME  WE'VE  PASSED  MAX 
C 

C  SOMETIMES  AT  LOW  HOB  PK  WILL  DROP  SLIGHTLY  THEN  LATER  INCREASE 
C  HENCE  WE  TEST  FOR  IT<3 


IF(X.LT.XSAVE.AND.IT.GT.2)G0  TO  160 
C  IF  PK/OFFSET  HAS  INCREASED  SAVE  NEW  MAX 
HOBSAV=HOBI 
XSAVE=X 
150  CONTINUE 

C  IF  FELL  OUT  OF  LOOP  PK/OFFSET  WAS  STILL  INCREASING  SO  HIT  MAX 
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GO  TO  180 
C 

C  END  OF  SUB -ITERATION  LOOP 
160  ITS=ITS+1 

C  WE  ARE  DONE  IF  HAVE  BEEN  THRU  LOOP  4  TIMES 
IF(ITS.GT.4)G0  TO  180 

C  WE  ARE  DONE  IF  PK/OFFSET  WAS  ZERO  AT  H0B=0 
IF(ITSAV.EQ.l)GO  TO  180 
C 

C  SET  LIMITS  OF  INTERVAL  SPANNING  MAX 
C 

IF(ITSAV.EQ.2)GO  TO  170 
C  WE  HAVE  3  POINTS  STRADDLING  MAX 
STEP=(H1-H3)/11. 

START=H3 
GO  TO  30 

C  WE  HAVE  ONLY  2  POINTS 
170  STEP=(H1-H2)/11. 

START=H2 
GO  TO  30 
C 

C  WE  HAVE  FOUND  THE  OPTIMUM 
C 

180  HOBI=HOBSAV 
KFX=KFACT 

IFdETA.EQ.  1)0FFNM=XSAVE 

CALL  PDCLC4 ( I V , JT . KFX , YLD , HOBI , R95NM , CEP , OFFNM , WR , P , IFLGC2 . lERR , 
1  AZMTH) 

C  NEXT  2  LINES  FOR  DEBUG 

C  WR ITE ( 6 , 7  7  9 ) P , 0FFNM*60  76 .115, HOBSAV 

C779  FORMATC  BEST  P,OFFNM,HOB=’,F10.6,F10.1,F10.3) 

RETURN 

END 

SUBROUTINE  HB0PT4 ( I V , JT.KF , YLD , HOB  1 , lERR) 

C 

c 

C  THIS  ROUTINE  IS  PART  OF  0PTHB4  AND  WAS  DEVELOPED  BY 
C  THE  STONEHOUSE  GROUP  INC  (303)  850-9851 

C  IT  INCLUDES  CODE  E.XTRACTED  FROM  PDCLC4 

DIMENSION  JTD(23),JJTD(23),KFN(27),KFI(27) 

C  NE.XT  LINE  CHANGED  BY  WLC  ON  6-10-86  AS  PER  SUN  MEMO  14  MAR  86 
COLD  DATA  JTD  / 'R* , 'S' . 'Q' , 'T' , 'U' . 'L' , 'P' , 'M* , 'N' , 'O' , 


COLD  DATA  JTD  / ' R' , ' S ' . 'Q' , 'T' , ' U ' . ' L' , ' P' , ' M' , 'N' , ' 0 ' , 

COLD  1  'x','y','z','w','v','a','b'.'c','d',’e','f',’i','h7 

C  CHANGED  BY  SDG  FOR  IBM  COMPATIBILITY 
C  DATA  JTD  /'R','S',’Q’,'T','U','L','P','M','N','0', 

C  1  'Y','X','Z','W'.'V','A’,'B','C','D','E'.'F','I',’H'/ 

CPRIME  FOR  MULTIC  AND  CRAY  (LOWERCASE  ADD  NE.XT  LINE 
C  MUST  CHANGE  NEXT  TO  UPPER  CASE 

DATA  JTD  /1HR,1HS,1HQ,1HT,1HU,1HL,1HP,1HM,1HN,1H0, 
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1  IHY , IHX , IHZ , IHW , IHV , IHA , IHB , IHC , IHD , IHE , IHF , IHI , IHH/ 

DATA  JJTD  /  5*2,  5*1,  5*0,  5,  6,  7,  8,  9,  10,  3,  4  / 

C  TABLE  KFN  CONTAINS  POSSIBLE  NUMERIC  LITERALS  (EBCDIC)  FOR  KF  THAT 

C  NEED  TO  BE  CONVERTED  INTO  INTEGER 

CSDG  CHANGED  BY  SDG  FOR  IBM  COMPATIBILITY 

CSDG  DATA  KFN  /'O' , ' l’ , '2' , '3' , '4' , '5' , '6' , '7' , '8' , '9' , 'A' , 'B' , 'C' , 


CSDG 


1 


D,EjF,G,H,I  ,J,K,L,M,N,0,P,Q/ 


CPRIME  FOR  MULTIC  /ND  CRAY  (LOWERCASE  ADD  NEXT  LINE 
C  MUST  CHANGE  NEXT  TO  UPPER  CASE 

DATA  KFN  /IHO, IHl , 1H2 , 1H3, 1H4, 1H5, 1H6, 1H7, 1H8, 1H9 , IHA, IHB , IHC, 

}  IHD , IHE , IHF , IHG , IHH , IHI , IHJ , IHK , IHL , IHM , IHN , IHO , IHP , IHQ/ 

DATA  KFI  /  0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,10,11,12,13,14, 
15,16,17  / 


C 

C 


C 

C 


1 


DO  10  M=l,15 

IF(JT.EQ.JTD(M))  GO  TO  20 
10  CONTINUE 

JT  IS  NOT  A  VALID  ALPHA  CHARACTER  (P,Q,  OR  Z-TYPES) 
lERR  =  9 
GO  TO  900 
20  JJT  =  JJTD(M) 

IF(JJT.EQ.O)RETURN 


C  CONVERT  KF  TO  INTEGER  IF  IT  IS  NUMERIC  LITERAL  (EBCDIC) 
KFI  =  KF 

IF  (KFI  .GE.  0  .AND.  KFI  .LE.  9)  GO  TO  40 
CO  30  1^1,27 

IF  (KFI  .NE.  KFN(I))  GO  TO  30 
KFI  =  KFI(l) 

GO  TO  40 
30  CONTINUE 
40  lERR  =  0 

100  CALL  WR0PT4(YLD,H0B1,aV,JJT,KF1,IERR) 


900  RETURN 
END 

c 

SUBROUTINE  WK0PT4  (YLD,  Hv.  .,  IV.  JJT,  KF,  I  ERR) 

C 

^  V*  V«  Vc  Vf  •W«  V?  Vt  V«  V*  V*  «V  <W«  Vt  •'»  vV  4VfV  Vr«W*  «W^«V«W?V»  (V  tV  tWfy?  fW*  *WrV»  ^  tW?  4V  #W» 

c 

c 

C  WR0PT4  IS  fHE  SUBROUTINE  WHICH  CALCULATES  OPTHOB  USING  THE 
C  7TH  ORDER  POLYNOMIAL  COEFFICIENTS  Ii>  THE  DATA  STATEMENTS  BELOW. 


C  CALLED  FROM:  MAIN 
C  SUBROUTINES  CALLED:  NONE 
C  ERROR  FLAGS  SET:  26 
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C 


C 

C 

C 

C 

C 

C 

C 


C 


C 


C 


C 


C 


C 


C 


C 


c 

c 


c 


c 


DIMENSION  WP(8,18),WQ(8,13) 

DIMENSION  WP1(72),  WP73(72),  WQl (72) ,WQ73(32) 

DIMENSION  TAVNP (18), TAVNQ (13), TSHOBP ( 1 8 ) , TSHOBQ ( 13 ) 
EQUIVALENCE  cWP(l,l),  WPl(l)),  (WP(1,10),  WP73(1)) 
EQUIVALENCE  (WQ(1,1),  WQl(l)),  (WQ(1,10),  WQ73(1)) 

ARRA't  WP  CONTAINS  THE  VALUES  FOR  THE  7TH  ORDER  POLYNOMIAL 
APPROXIMATION  FOR  WR  COMPUTATIONS  FOR  P-TYPE  TARGETS 
AO  A1  A2  A3 

A4  AS  A6  A7 

DATA  WPl  / 

SHOE  0  AVN  56-81 


1  2.2184403E+03,-2.0384393E+02, 

1  1.7921431E-03,-1.0791711E-05, 
SHOE  0  AVN  0-56 

2  8.4179382E+00,-1.3959558E-01, 

2  -6.5171236E-06,  1.5734555E-07, 
SHOE  20  AVN  0-56 

3  8.4160310E+00,-1.3813430E-01, 

3  -6.2927942E-06,  1.4873461E-07, 
SHOE  40  AVN  0-56 

4  8.4180053E+00,-1.3961422E-01, 

4  -2.0087108E-06,  3.9934521E-08, 
SHOE  60  AVN  0-56 

5  8.4211949E+00,-1.4202190E-01, 

5  7.5497819E-06,-2.5450718E-07, 
SHOE  80  AVN  0-53 

6  8.4197832E+00,-1.3563252E-01, 

6  8.2651528E-0/,-1.0230794E-07, 
SHOE  100  AVN  0-50 

7  8.4220240E+00,-1.3292575E-01, 

7  -2.9712949E-06,  8 . 7281946E-09 , 
SHOE  150  AVN  0-44 

8  8.4293786E+00,-1.2330468E-01, 

8  -2.7993967E-05,  8.2785321E-07, 
SHOE  200  AVN  0-39 

9  8.4413856E+00,-1.1560827E-01, 
9  -6.3588183E-05,  2 . 2044664E-06 , 

DATA  WP73  / 

SHOE  250  AVN  0-35 
0  8.4601291E+00,-1.2040847E-01, 

0  -1.7089906E-05,  6.2849153E-08, 
SHOE  300  AVN  0-31 
1  8.4754194E+00,-1.0937908E-01, 

1  -1.0568408E-04,  4 . 0196970E-06 , 
SHOE  400  AVN  0-26 

2  8.5159454E+00,-1.1143596E-01, 
2  -6.2141343E-05,  1 .5174377E-06, 
SHOE  500  AVN  0-23 


7.7871809E+00,-1.5791337E-01, 
2.6937624E-08,  0 . OOOOOOOE-00 , 

8.8874C34E-04,  1 „ 1S57732E-04 , 
1.8676597E-09,  8.8525577E-12, 

8.0858875E-04,  1 . 1427499E-04 , 
1.7160814E-09,  7 . 8715866E-12 , 

1.5111330E-03,  3.0401988E-05, 
3.5144936E-10,  1 . 1769646E-12, 

¥ 

2.6598384E-03,-1.2677356E-04, 

4.1500872E-09,-2.5841146E-ll, 

1. 1721849E-03,  1 . 6556857E-05 , 
2.7109759E-09,-2.2855071E-ll, 

5.7368186E-04,  8 . 1226392E-05 , 
1.2926994E-09,-1.7542970E-ll, 

2.2974151E-03,  4 . 6028691E-04, 
1.1068193E-08,  4.7149273E-11, 

5.0750819E-03,  9 . 1014643E-04 , 
3.5583928E-08,  2.0069297E-10/ 


2.2218012E-03,  3 . 7792663E-04 , 
1.4857856E-08,-2.8212514E-10, 

7.3913453E-03,  1 . 3609095E-03 , 
6.8227444E-08,  3.4506826E-10, 

5.4504395E-03,  9 .4122080E-04, 
1.0523437E-08,-7.5193318E-10, 
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C 


C 

C 


C 


C 


C 

C 

C 

C 

c 

c 

c 


c 


c 


c 


c 


c 

c 


c 


c 


3  8.5569860E+00,-1.0972237E-01,-6.7923668E-03, 

3  -1.4673425E-04,  8.0009S79E-06,-2.2030310E-07, 
SHOE  600  AVN  0-20 

4  8.5973073E+00,-1.0471815E-01,-1.2002061E-02, 

4  -4.3312089E-04,  3 . 0708138E-05 , -1 . 0989039E-06 , 
SHOE  700  AVN  0-17 

5  8.6370475E+00,-1.1089467E-01,-6.9620463E-03, 

5  -1.5484446E-04,  7 . 9600450E-06, -1 . 9285094E-07 , 
SHOE  800  AVN  0-16 

6  8.6743792E+00,-1.1313355E-01,-6.5949126E-03, 

6  -2.4400379E-04,  2. 1765577E-05,-l. 1223631E-06, 
SHOE  900  AVN  0-14 

7  8.7092355E+00,-1.1397120E-01,-8.0841576E-03, 

7  -4.6153006E-04,  4 . 8096946E-05 , -2 . 7690109E-06 , 
SHOE  1000  AVN  0-13 

8  8 . 7415762E+00 , - 1 . 1614030E-01 , -6 . 7527 lOOE-03 , 
8  -2.5295514E-04,  2 . 2554333E-05 , - 1 . 4888147E-06 , 


1.4664351E-03, 

2.1593173E-09, 

3.2875424E-03, 

1.4974601E-08, 

1.5757880E-03, 

2.8938727E-10, 

1.7651464E-03, 

2.1846853E-08, 

2.6655422E-03, 

6.1358427E-08, 

1.8639925E-03, 

4.0146349E-08/ 


ARRAY  WQ  CONTAINS  THE  VALUES  FOR  IHE  7TH  ORDER  POLYNOMIAL 
APPROXIMATION  FOR  WR  COMPUTATIONS  FOR  Q-TYPE  TARGETS 
AO  A1  A2  A3 

A4  A5  A6  A7 


DATA  WQl  / 

SHOE  0  AVN  0-31 

1  8.5683018L+00,-l. 1510151E-01,-6.6364862E-03,  7 . 2839394E-04, 

1  -2.3600397E-05.-8.4432731E-08,  1.8096256E-08,-2.5411405E-10, 
SHOE  50  AVN  0-31 

2  8.5116824E+00,-1.0856551E-01,-2.0629193E-03,-2.7238797E-04, 

2  6. 1467099E-05.-3.7033619E-06,  9 . 525 1501E-08 , -9 . 1279440E-10 , 
SHOE  100  AVN  0-31 

3  8.4972379E+00,-1.0866530E-01,  1 . 8464289E-04 , -7 . 0132541E-04 , 

3  9.8338051E-05,-5.4160834E-06,  1 . 3724567E-07 , -1 . 3387035E-09 , 
SHOE  150  AVN  0-29 

4  8.4992043E+00,-1.0947870E-01,  4 . 2027552E-04 , -7 . 3553498E-04 , 

4  1.0483617E-04,-6.0487282E-06,  1 . 6313776E-07 , - 1 . 7154270E-09 , 
SHOE  200  AVN  0-26 

5  8.5103129E+00,-l. 1110023E-01,  5 . 241 7582E-05 , -6 . 17 16155E-04 , 

5  9.7602539E-05,-6. 1707540E-06,  1  8386975E-07 , -2 . 1613502E-09 , 
SHOE  300  AVN  0-22 

6  8.5448195E+00,-1.1378886E-01,-7.6733464E-04,-2.6232760E-04, 

6  5.9616371E-05,-4.6826100E-06,  1 . 7332408E-07 , -2 . 5849008E-09 , 
SHOE  400  AVN  0-20 

7  8.5823836E+00,-l. 1398686E-01,-1.5108814E-03,  1 . 1706741E-04, 

7  2.0986961E-06,-7.6070167E-07,  4 . 9900467E-08 , - 1 . 2606168E-09 , 
SHOE  500  AVN  0-18 

8  8.6177199E+00,-l. 1344578E-01.-1.4956039E-03,  2.4153006E-04, 

8  -2.6966891E-05,  1 . 9060892E-06 , -5 . 8805631E-08 ,  1 . 8404569L-10 , 
SHOE  600  AVN  0-16 

9  8.6515113E+00,-1.124l013E-01,-1.4792271E-03,  3.4909168E-04, 
9  -5.9007318E-05,  5 . 6407 188E-06, -2 . 5394592E-07 ,  3 . 6620433E-09/ 
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DATA  WQ73  / 

C  SHOE  700  AVN  0-14 

0  8.6837151E+00,-l.li49938E-01,-1.0799724E-03,  2.2999230E-04, 

0  -4.3658280E-05,  4.9214399E-06,-2.6356030E-07,  4.0804823E-09, 

C  SHOE  800  AVN  0-12 

1  8.7142384E+00,-l. 1028039E-01,-1.2589773E-03,  3 . 9539600E-04 , 

1  -9.5934929E-05,  1 . 2624932E-05 , -8 . 1212801E-07 ,  1 . 7934666E-08 , 

C  SHOE  900  AVN  0-11 

2  8 . 7431825E+00 , - 1 . 0959267E-01 , -4 . 4135161E-04 , -6 . 9078548E-05 , 

2  2.1081549E-05,-1.9568679E-06,  0 . OOOOOOOE+00 ,  0 . OOOOOOOE+00 , 

C  SHOE  1000  AVN  0-9 

3  8.7705694E+00,-1.0844576E-01,-8.3636006E-04,  1 . 0307509E-04 , 

3  -9.8394610E-06,-1.3492662E-06,  O.OOOOOOOE+00,  0 . OOOOOOOE+UO/ 

C 

C 

C  ARRAYS  TAVNP  AND  TAVNQ  CONTAIN  THE  HIGHEST  ALLOWAELE  ADJUSTED  VNS 

C  FOR  WHICH  THE  POLYNOMIAL  CURVE  FIT  DATA  IS  VALID,  TSHOBP  AND 

C  TSHOEQ  CONTAIN  THE  HIGHEST  ALLOWAELE  SCALED  HOES  FOR  WHICH  THE 
C  SAME  DATA  IS  VALID 
C 


DATA  TAVNP 

/  81. 

,  56. 

,  56. 

.  56. 

,  56. 

,  53. 

,  50. 

.  ^4. 

.39., 

A 

35. 

,  31. 

,  26. 

,  23. 

,  20. 

,  17. 

,  16. 

,  14. 

,  13./ 

DATA  TAVNQ 

/  31. 

,  31. 

,  31. 

,  29. 

,  26. 

.  22. 

,  20. 

,  18. 

,  16., 

A 

14. 

.  12. 

.  11. 

.  9. 

/ 

DATA  TSHOBP 

/  0. 

,  0. 

,  20. 

,  40. 

,  60. 

,  80. 

,100. 

,150. 

,200., 

A 

250. 

,300. 

,400. 

,500. 

,600. 

,700. 

,800. 

,900. 

,1000. 

DATA  TSHOEQ 

/  0. 

,  50. 

.100. 

,150. 

,200. 

,300. 

,400. 

,500. 

,600.  , 

A 

700. 

,800. 

,900. 

,1000 

./ 

C 

IF  (KF  .GE.  0  .AND.  KF  .LT.  10)  GO  TO  10 
lERR  =  6 
RETURN 
10  JT  =  JJT 
VN  =  IV 
FK  =  KF 

YLDCU  =  YLD**. 33333333 
YLDIC=  1. /YLDCU 
H0B1=0. 

SHOB=  H0B1*YLDIC 
FKIO  =  FK*.l 
C 

C  CALCULATE  ADJUSTED  VN  USING  THE  FOLLOWING  FORMULA,  FROM  DIA 
C  PHYSICAL  VULNERABILITY  HANDBOOK  -  NUCLEAR  WEAPONS  AP-550-1-2-69 

C 

C  ADJUSTED  VN  =  VN  +  D  *  LOG(R) 

C  WHERE , 

C  D  =  2.742  (FOR  Q  TYPE)  OR  5.485  (FOR  P  TYPE) 

C  R  =  1-(KFACTOR/10)+(KFACTOR/10)*((20/YLD)**1/3)*(R**C) 

C  C  =  1/3  (FOR  Q  TYPE)  OR  1/2  (FOR  P  TYPE) 

C 


o  o  o  o  o  o  o 
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IF  (JT  .EQ.  1)  GO  TO  20 
C  SET  VALUES  FOR  'Q'  TYPE 

R  =  3.0 

CEXP  =  .33333333 
D  =  2.742 
GO  TO  30 
20  CONTINUE 

C  SET  VALUES  FOR  'P'  TYPE 

R  =  2.0 
CEXP  =  .5 
D  =  5.485 
30  CONTINUE 

THIS  ALGORITHM  FINDS  THE  PROPER  "R"  VALUE  AND  CALCULATES  AVN 

40  R1  =  l.-FK10*(l.-2.7144176*YLDIC*(R**CEXP)) 

ABDIF  =  R1  -  R 
R  =  R1 

ABDIF  =  ABS(ABDIF) 

IF  (ABDIF  .GE.  .001)  GO  TO  40 
AVN  =  VN  +  D  *  ALOG(R) 

SET  THE  SUBSCRIPTS  FOR  ENTERING  THE  COEFFICIENT  TABLE.  FIRST 
CHECK  FOR  SHOB  =  0 

IF  (JT  .EQ.  1)  GO  TO  80 

Q  VrV.  i‘.  i.Vf.ir***Vf***iV*Vf**vV*>VVrVlrjV!V***A;V*****A**'sVVr****>V*Vf  ****** 

C  'Q'  TYPE  TARGETS 

IF  (AVN  .LE.  TAVNQ(l))  GO  TO  60 
lERR  =  2 
RETURN 
60  CONTINUE 

I0PT=1 

DO  800  1=1,13 

IF(AVN.GT.TAVNQ(I))GO  TO  801 

SWRLO=  WQ ( 1 , I ) +AVN* ( WQ ( 2 , I ) +AVN* ( WQ ( 3 , I ) +AVN* ( WQ ( 4 , I ) + 

1  A VN* ( WQ ( 5 , I ) +AVN* ( WQ ( 6 , I ) +AVN* ( WQ ( 7 , I ) +AVN* WQ (8,1))))))) 
CDEBUG 

C  WRITE ( 6 , 6000 ) I , TSHOBQ ( I ) , SWRLO 

C6000  FORMATC  I,SH0B,SWRL=' ,I2,F10.4.F15.6) 

IF(SWRLO.LT.O.)GO  TO  801 
IF(I.EQ.1)G0  TO  778 
IF(SWRLO/SWRLOO.LT.  0.9)GO  TO  801 
IF(SWRLO.LT.SWRLOO)GO  TO  800 
778  IOPT=I 

SWRLOO=SWRLO 

800  CONTI.NUE 

801  SHOB=TSHOBQ(IOPT) 

H0B1=SH0B*YLDCU 

CDEBUG 

C  WRITE(6,6010)IOPT,SHOB,KOB1 


C6010  FORMATC  I0PT,SH0B,H0B1=’ ,I2,F10.4,F10.3) 
SHOBT=HOBl-'-YLDIC 
IF(IOPT.EQ.l)RETURN 
I F ( SHOBT . LT . TSHOBQ ( I OPT ) ) RETURN 
802  HOB 1=H0B1*. 9999 
SHOBT=HOBl*YLDIC 

IF(SHOBT.GE.TSHOBQ(IOPT))GO  TO  802 
RETURN 

80  CONTINUE 

C  'P'  TYPE  TARGETS 

IF  (AVN  .LE.  TAVNP(2))  GO  TO  100 
IF  (AVN  .LE.  TAVNP(l))  GO  TO  120 
lERR  =  2 
RETURN 
100  CONTINUE 

ILO  =  2 
GO  TO  877 
120  CONTINUE 

ILO  =  1 

877  IFCILO.NE. l)GO  TO  878 
HOB  1=0. 

CDEBUG 

C  WRITE(6,6010)IOPT,SHOB,HOB1 

RETURN 

878  IOPT=2 

DO  900  1=2,18 

IF(AVN.GT.TAVNP(I))GO  TO  901 

SWRLO=  WP ( 1 , I ) +AVN* ( WP (2,1 )+AVN* (WP (3,1 )+AVN* (WP (4 , I )+ 

1  AVN*(WP(5 , I )+AVN*(WP(6 , I )+AVN*(WP(7 , I )+AVN*WP(8 , I )))))) ) 
CDEBUG 

C  WR ITE ( 6 , 6000 ) 1 ,TSHOBP ( I ) . SWRLO 

IF(SWRLO.LT.O.)GO  TO  901 
IF(I.EQ.2)G0  TO  879 
IF (SWRLO/ SWRLOO.lt.  0.9)G0  TO  901 
IF(SWRLO.LT.SWRLOO)GO  TO  900 

879  IOPT=I 
SWRLOO=SWRLO 

900  CONTINUE 

901  SHOB=TSHOBP(IOPT) 

H0B1=SH0B*YLDCU 

CDEBUG 

C  WRITE(6,6010)IOPT,SHOB,HOB1 
SH0BT=H0B1*YLDIC 
IFdOPT.LE.  2)  RETURN 
I F ( SHOBT . LT . TSHOBP ( I OPT ) ) RETURN 

902  H0B1=H0B1*.9999 
SH0BT=H0B1*YLDIC 

IF(SHOBT.GE.TSHOBP(IOPT))GO  TO  902 


RETURN 
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END 
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SUBROUTINE  RCAST1  ( IRCAST) 

C 

C  RCASTl  recasts  or  rewrites  the  current  objective,  if  necessary, 
C  and  regenerates  the  liat  of  allowable  weapons  to  be  applied  to 
C  it.  An  objective  is  recast  ONLY  if: 

C  1)  there  are  untargeted  targets  (that's  what  set 

C  IRCAST  to  non-zero  in  the  first  place,  AND 

C  2)  there  are  more  allocatable  weapons... 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$  INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'AWE APS. CDE' 

$  INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'PRINT. CDE' 

$  INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'TARGT.CDE' 

C 

TGOFOR(ICO)  =  TGOFOR(ICO)  -  NWA(l) 

C 

DETOT  =  0 

IB  =  INDXdCOP.l) 

IE  =  INDX(ICOP,2) 

IF(IB.NE.O)  THEN 
DO  100  I  =  IB, IE 

C  Discount  any  first  weapons  of  a  pair... 

IF(WPT(I).EQ.-1)  GOTO  100 

DETOT  =  DETOT+  DEA(I , ISC)*ATNUM(I ) 

100  CONTINUE 
ENDIF 

DETOT  =  DETOT/TNUM(ICO) 

I F (I PR I NT . NE . 0 . AND . OPR ( I CO ) . GE . TP 1 . AND . OPR ( I CO ) . LE . TP2 )  THEN 
WRITE(15,*) 

WRITE(15,3000)  'RCASTl:  Current  DE:  '.DETOT 
WRITE(15,3000)  '  GoalDE:  ',ODEl(ICO) 

ENDIF 

3000  F0R.MAT(1X,A20,F5.3) 

C 

C  Check  that  the  DE  is  met... 

IF(IHCAST.EQ.O)  THEN 

IF(IPRINT.NE.O.A.ND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2) 

+  THEN 

IF(DETOT.GE.ODE1(ICO))  THEN 

WRITE(15,*)  '  Goal  DE  has  been  met.' 

ELSE 

WRITE (15,*) 

+  '  Objective  has  been  covered  with  1  wpt . ' 

ENDIF 
GOTO  1000 
ENDIF 
ELSE 
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IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2) 
+  WRITE (15,*) 

+  '  Rewriting  the  target  objective  for  targets 

+  'not  yet  covered...' 

ENDIF 

C 

1000  RETURN 
C 

END 


SUBROUTINE  RCAST2(IMDR) 

C  RCAST2  does  the  second  pass  of  FALCON.  IMDR  is  an  input  flagging 
C  whether  Pass  2  weapons  are  being  allocated  globally  (IMDR=0)  or 
C  whether  Pass  2  allocations  are  being  determined  as  part  of  Pass  1 
C  for  a  single  objective  (IMDR=K,  where  K  is  the  index  of  the 
C  objective  requiring  additional  weapons  be  allocated  to  meet  the 
C  DE  objective  before  going  on  to  a  lower  priority  objective,  i.e. 

C  MDR(K)='*').  For  IMDR=0,  RCAST2  goes  through  each  of  the  objectives 
C  in  priority  order.  If  the  objective  has  been  met  or  each  target  in 
C  the  objective  has  been  covered  with  2  wpt,  RCAST2  moves  on.  If  the 
C  objective  has  not  been  met,  and  the  2  wpt  limit  has  not  been 
C  exceeded,  RCAST2  determines  which  subset  of  weapons 
C  requires  the  higher  DE,  the  exact  value  of  the  DE 
C  required,  and  then  allocates  remaining  weapons  appropriately. 

C  For  IMDR=K  (not  equal  to  0)  the  above  procedure  is  followed  using 
C  all  Pass  2  logic,  but  allocations  are  found  for  the  single  objective. 
C  Note:  IDGO  tells  when  to  go  on  to  the  next  sub-objective  (IDG0=1)... 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$  INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'AWEAPS.CDE* 

$  INCLUDE:  'OBJ. CDE' 

$INCLUDE:  'PRINT. CDE' 

$  INCLUDE:  'PRIO.CDE' 

$  INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'TARGT.CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

C  Reset  the  rules  for  Pass  2... 

PORDER  =  P2(2,l) 

ARTU  =  P2(2,2) 

ARDE  =  P2(2,3) 

ARMOF  =  P2(2,4) 

ARFOM  =  P2(2,5) 

C  Reset  the  objective  values,  if  necessary... 

IF(INDR.NE.O)  THEN 
SAV  =  ODEl(lHDR) 

ODEl(IMDR)  =  0DE2(IMDR) 

0DE2(IMDR)  =  SAV 
ELSE 

DO  50  K  =  l.NOBJ 
SAV  =  ODEl(K) 

ODEl(K)  =  0DE2(K) 

0DE2(K)  =  SAV 
50  CO.NTINUE 
END  IF 
C 

C  Loop  through  the  objectives  in  priority  order  and  do  any 
C  necessary  initializations... 
lE.N’D  =  N’OBJ 
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IF(IMDR.NE.O)  THEN 
lEND  =  1 
ICO  JMDR 
ENDIF 

DO  100  K  =  l.IEND 
IF(IMDR.EQ.O)  THEN 
ICO  =  IPRIO(K) 

ICOP  =  K 
ENDIF 

C  Skip  this  objective  if  RCAST2  has  already  been  called... 
IF(IMDR.EQ.O.AND.MDR(ICO).EQ. '*')  GOTO  100 
IB  =  INDXdCOP.l) 

IE  =  INDX(ICOP,2) 

C  If  the  pass  2  DE  goal  is  zero,  return  to  work  on  next  objective.. 
IF(ODEl(ICO).EQ.O)  THEN 

IF ( IPRINT . NE . 0 . AND . OPR ( ICO) . GE . TPl . AND . OPR ( ICO) . LE . TP2 )  THEN 
WRITE (15,*) 

'‘'RITECIS,*) 

+  'RCAST2:  This  objective  has  a  zero  Pass  2  DE  goal 

WRITE(15,*) 

+  '  Returning  to  work  on  next  objective.' 

ENDIF 
GOTO  100 
ENDIF 
C 

DEOLD(ICO)  =  DEI(INDX(IC0P,2)) 

C 

C  Call  REINIT  only  if  this  is  a  single  objective  Pass  2  allocation 

C  (IMDR.NE.O)  or  IMDR.EQ.O  and  Pass  2  allocations  have  not  yet  been 

C  done  (check  for  MDR.EQ. '*').. . 

IFdMDR.NE.O.OR.  (IMDR.EQ.O.AND.MDR(ICO)  .NE.  '*’))  THEN 
CALL  REINIT 
ENDIF 
C 

C  Initialize  the  IDGO  array... 

DO  60  I  =  1,100 
IDGO(I)  =  0 
60  CONTINUE 
C 

105  CONTINUE 
C 

C  Check  whether  the  goal  has  been  met... 
IF(DEOLD(ICO).GE.ODE1(ICO).OR. 

+  (IMDR.EQ.O.AND.MDR(ICO).EQ. '*'))  THEN 
C  If  the  MDE  has  been  met  (IDEP(2)=2),  go  on  to  next  objective.. 

IF(IDEP(2).EQ. '2')  THEN 

IF(IPRINT.NE.0.AND.0PR(IC0).GE.TP1.AND.0PR(IC0;.LE.TP2) 

+  THEN 

WRITE (15,*) 

WRITE ( 15 , 2030)  'RCAST2:  Goal  DE  for  target  objective: 

+  TOBJ(ICO),’  has  been  met.' 
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ENDIF 
GO  TO  100 
ELSE 

C  Check  if  IDE  has  been  met  (IDEP(2)=1)  for  each  sub-objective. . . 

C  (increment  IDE  for  each  weapon/pair  that  doesn't  meet  IDE) 

IDE  =  0 

IF(IB.EQ.O)  GOTO  120 
DO  90  J=IB,IE 

C  Discount  first  weapon  of  a  pair... 

IF(WPT(J).EQ.-1)  GOTO  90 
IF(DEA(J,ISC).LT.0DE1(IC0))  IDE  =  IDE  +  1 
C  Check  for  untargetted  objectives... 

IF(TG0F0R(IC0).NE.0)  IDE  =  IDE  +  1 
90  CONTINUE 

IF(IDE.EQ.O)  THEN 

IF (IPRINT . NE .  0 . AND . OPR ( ICO) . GE . TP  1 .  AND . 

+  0PR(IC0).LE.TP2)  THEN 

WRITE (15,*) 

WRITE(15,*)  'RCAST2:  Target  objective:  ' ,T0BJ(IC0) 
WRITE(15,*)  '  has  met  individual  DE  goal.' 

ENDIF 
GOTO  100 
ENDIF 
ENDIF 
ENDIF 

If  each  target  has  received  2  weapons,  go  on  to  next  objective... 
(i.e.  sum  all  the  weapons  and  compare  with  2  x  No  of  targets.) 

I SUM  =  0 

DO  110  J  =  IB, IE 

IF(WPT(J).EQ.-1)  GOTO  110 
I SUM  =  I SUM  +  ABS(WPT(J))*ATNUM(J) 

C  Add  ATNUM  again  for  cross-pass  pairs... 

IF(AWTYP(J,i).NE.O.AND.AWTyP(J,2).NE.O) 

+  ISUM  =  ISUM  +  ABS(WPT(J))*ATNUM(J) 

110  CONTINUE 

I F ( I SUM . GE . 2*TNUM (ICO))  THEN 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO) .LE.TP2) 

+  THEN 

WRITE (15,*) 

WRITE (15,*)  'RCAST2:  Target  objective:  ',T0BJ(IC0) 

WRITE(15,*)  '  has  received  two  weapons  per  target.' 

ENDIF 
GO  TO  100 
ENDIF 
C 

120  IF(IPRINT.NE.O..AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
WRITE (15,*) 

WRITE(15,2020)  'RCAST2:  Working  on  target  objective:  ', 

+  TOBJ(ICO),'  of  priority  ',OPR(ICO) 

IF ( IMDR . EQ . 0)  WRITE (* , 2020) 
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+  '  Working  on  target  objective: 

+  TOBJ(ICO),'  of  priority  ',0PR(IC0) 

ENDIF 

IF(IB.EQ.O.AND.TGOFOR(ICO).EQ.O)  THEN 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2) 

+  WRITE(15,*)  '  No  subsets  to  evaluate  for  this 

+  'objective.' 

GOTO  100 
ENDIF 

Determine  which  subset  has  the  lowest  DE...i.e.  find  the  index 
of  the  line  which  does  not  have  2  weapons  allocated  and  which 
does  have  the  lowest  DE... 

DELOW  =1.0 

IDLOW  =  0 

IB  =  INDXdCOP.l) 

IE  =  INDX(IC0P,2) 

DO  250  J  =  IB, IE 

Discount  all  same-pass  pairs... 
IF(WPT(J).LT.O.OR.WPT(J).GT.l)  GOTO  250 
Discount  all  cross-pass  pairs... 
IF(AWTYP(J,1).NE.0.AND.AWTYP(J,2).NE.0)  GOTO  250 
Discount  any  subsets  where  nothing  more  can  be  done... 
IF(IDGO(J-IB+l).EQ.l)  GOTO  250 
IF(DEA(J, ISC). LT. DELOW)  THEN 
DELOW  =  DEA(J,ISC) 

IDLOW  =  J 
ENDIF 
250  CONTINUE 


Check  the  selected  subset  to  see  if  additional  allocations 
can  be  made. . . 

IF (DELOW. EQ.l)  THEN 

I F ( I PR I NT . NE . 0 . AND . OPR ( I CO ) . GE . TP 1 . AND . OPR ( I CO ) . LE . TP2 )  THEN 
WRITE(15,*)  '  Objective  has  been  met  as  well 

+  'as  possible.' 

WRITE(15,*)  '  Returning  to  work  on  next  objective.' 

ENDIF 
GOTO  100 
ENDIF 

Calculate  the  DE  required  for  this  subset  of  weapons... 

DEREQ  =  1.  -  ( 1.-0DE1( ICO) )/(l. -DELOW) 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
IF(AWTYP(IDL0W,1) .EQ.O)  THEN 
WRITE(15,2000) 

+  '  Working  on  targets  not  targeted  in  Pass  1  ' 

WRITE(15 ,2010)  '  Current  DE  for  allocate  >n  subset:  ', 

+  DELOW 

WRITE(15,2015)  '  Additional  weapon  per  target  DE  re'. 
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+  'quired  to 

ELSE 

WRITE (15, 2005)  ' 

+  IDLOW-IB+1 

WRITE(15,2010)  ' 

+  DELOW 

WRITE(15,2015)  * 

+  'quired  to 

END  IF 
ENDIF 


meet  Pass  2  Goal:  ' ,DEREQ 

Working  on  1st  Pass  Subset: 

Current  DE  for  allocation  subset: 

Additional  weapon  p  target  DE  re', 
meet  Pass  2  Goal:  ' ,DEREQ 


C 

C  Sort  the  weapons  for  this  suballocation. . . 

CALL  WS0RT2(IDL0W,DEREQ) 

C 

C  Select  a  weapon. . . 

CALL  WSELCT 

GOTO(100,255,255)  ICONT+1 
C 

C  Allocate  more  weapons  to  this  objective... 

255  CALL  WALLC2(IDL0W,IG00N) 

C  If  nothing  else  can  be  done  with  this  objective,  go  on... 
CALL  WCOUNT(NWEAP) 

IF(NWEAP.LE.O)  GOTO  140 
IF(IGOON.EQ.l)  THEN 
IDG0( IDLOW-IB+1)  =  1 
GOTO  105 
ENDIF 

IF(IDEP(2).EQ. '2' .AND.DENEW(IC0).GE.0DE1(IC0))  GOTO  100 
GO  TO  105 
C 

100  CONTINUE 
C 

C  Restore  the  goal  DEs  for  both  passes... 

140  IF(IMDR.NE.O)  THEN 
SAV  =  0DE2(IMDR) 

ODE2(IMDR)  =  ODEl(IMDR) 

ODEl(IMDR)  =  SAV 
ELSE 

DO  150  K=1,N0BJ 
SAV  =  0DE2(K) 

0DE2(K)  =  ODEl(K) 

ODEl(K)  =  SAV 
150  CONTINUE 
ENDIF 


Restore  the  Pass  1  rules... 
PORDER  =  P2(l,l) 

ARTU  =  P2(l,2) 

ARDE  =  P2(l,3) 

ARMOF  =  P2(l,4) 

ARFO.M  =  P2(l,5) 
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C 

RETURN 

C 

2000  FORMAT C IX, A50) 

2005  F0RMAT(1X,A36,I2) 

2010  F0RMAT(1X,A42,F4.3) 

2015  F0RMAT(1X,A42,A28,F6.3) 
2020  F0RMAT(1X,A37,A12,A13,I3) 
2030  F0RMAT(A38,A12,A14) 

C 

END 
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SUBROUTINE  READID 

C 

C  Governing  subroutine  for  reading  input  data... 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  'FDNAM.CDE' 

$  INCLUDE:  'RULB.S.CDE’ 

C 

C  Get  the  names  of  the  target  and  weapon  data  input  files... 

C 

WRITE(*,*)  'Enter  the  name  of  the  Target  Data  Input  File:  ‘ 
WRITE(*,*)  '  (max  8  characters  plus  3-character  extent)  ' 
READ (*,3090)  TFNAME 

WRITE (*,*)  'Enter  the  name  of  the  Weapons  Data  Input  File:  ' 
WRITE (*,*)  '  (max  8  characters  plus  3-character  extent)  ' 
READ (*,3090)  WFNAME 
C 

C  Read  the  objectives  data... 

CALL  READOD 
C 

C  Read  the  weapons  data... 

CALL  READWD 
C 

3090  F0RMAT(A12) 

C 

RETURN 

C 

END 
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SUBROUTINE  READOD 
C 

C  READOD  reads  in  all  input  objectives,  rules  and  other 
C  set  up  information  and  stores  these  in  OBJ,  RULES,  TARGT, 

C  and  PRINT  common  blocks . . . 

C 

IMPLICIT  INTEGER*4  (I-N) 

CHARACTER*126  LINE 
CHARACTER*70  TLINE(IO) 

CHARACTER*12  CNAM,CNAM2 
CHARACTER*6  RULNAM 
CHARACTER*!  L1,L2 
C 

$ INCLUDE:  'FDNAM.CDE' 

$ INCLUDE:  ’OBJ.CDE' 

$ INCLUDE:  ' PRINT. CDE' 

$ INCLUDE:  'PRIO.CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT. CDE' 

C 

0PEN(2,FILE=TFNAME) 

C 

C  Initialize  the  number  of  objectives  (J)  ,  and 
C  the  number  of  Title  lines  (ITN)  in  the  file. 

C 

J  =  0 
ITN  =  0 
C 

C  Set  other  default  rules. 

C 

CALL  SETDEF 
C 

C  Get  and  print  the  date  and  time.  Also  print  out  the  run  information. 
CALL  GETDAT(IYR,IMON,IDAY) 

CALL  GETTIH(IHR,IMIN,ISEC,IDUM) 

WRITE(16,3002)  'DATE:  ' ,IM0N, '/' ,IDAY, '/' ,IYR 

WRITE(16,3007)  'TIME:  ' ,IHR, ’ : ' ,IMIN, ' : ' ,ISEC 

WRITE(15,3002)  'DATE:  ' ,IMON, '/' ,IDAY, '/' ,IYR 

WRITE (15, 3007)  'TIME:  ' ,IHR, ' : ' , IMIN, ' : ' , ISEC 

C 

WRITE(*,*)  'Enter  the  run  name  (max  80  characters)  ' 

READ (*,3008)  RUNNAM 
DO  50  150  =  15,16 

WRITE(I50,3004)  'RUN  NAME;  ', RUNNAM 
WRITE(I50,3003) 

WRITE(I50,2015)  'INPUT  FILES:  ',TFNAME, 

+  '  for  target  objectives  and  rules  data  ' 

WRITE(I50,2015)  '  ',WFNAME, 

+  ’  for  weapons  data  ' 

WRITE(I50,2015)  'OUTPUT  FILES:  '.OFNAME, 

'  for  results  ' 


4* 
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WRITE(I50,2015)  ’  ’,AFNAME, 

+  '  for  the  audit  trail 

50  CONTINUE 
C 

100  READ  (2, 3000, END  =  800)  LINE 

IF(LINE(1:10).EQ. '  ')  GOTO  100 

READ(LINE,3000)  LI 
C 

IF(L1.EQ. 'C' .OR.Ll.EQ. 'I')  GO  TO  100 
IFCLl.EQ. 'T')  THEN 
ITN  =  ITN  +  1 
IF(ITN.GT.IO)  GO  TO  100 
TLINE(ITN)  =  LINE(2:71) 

GO  TO  100 
ENDIF 
C 

IFCLl.EQ. 'R')  GO  TO  300 
IFCLl.EQ. 'E')  GO  TO  800 


Everything  else. . . 

J  =  J  +  1 
IFCJ.GT.lOO)  THEN 

WRITEC15,*)  'READOD:  Error  in  input  data  >  Too  many  ' 
WRITEC15,*)  '  target  types.  Max  of  100  allowed.* 

WRITEC15,*)  'FALCON  STOPPING.  ' 

WRITEO"'.*)  'READOD:  Error  in  input  data  «  Too  many  * 

WRITEC*,*)  '  target  types.  Max  of  100  allowed.' 

WRITEC*,*)  'FALCON  STOPPING.  ' 

STOP 

ENDIF 

IFCISSPK.EQ. '2' .OR.ISSPK.EQ. '4')  THEN 

RE AD  C  LI NE , 3  0 1 0 , ERR=4 9 9 , END= 100 )  OPR  C  J ) , TOB J  C  J ) , TNUM  C  J ) , 

+  MOBTCJ) .PDETCJ) .TURCJ) .R95CJ) .AZMTHCJ) .OFFCJ) .VNTKl CJ) , 

+  rOBCJ),ODElCJ),ODE2CJ),WOCCJ,l),ANDORCJ),WOCCJ,2),MDRCJ), 

+  DMINCJ) 

IF C VNTKl CJ).EQ.O.)  THEN 

WRITEC15,*)  'READOD:  Error  in  input  data  -  target  '.TOBJCJ) 

WRITEC15,*)  '  hardness  may  not  be  zero.' 

WRITEC15,*)  'FALCON  STOPPING.  ' 

WRITEC*,*)  'READOD:  Error  in  input  data  -  target  '.TOBJCJ) 

WRITEC*,*)  '  hardness  may  not  be  zero.' 

WRITEC*,*)  'FALCON  STOPPING.  ' 

STOP 

ENDIF 

ELSE 

READ CLINE, 3020, ERR=499,END=100)  OPRCJ) ,T0BJCJ) .TNUMCJ) , 

+  MOBTCJ) ,PDETCJ) , TURCJ) ,R95CJ) ,AZMTHCJ) , OFFCJ) , VNTKl CJ) , 

+  VNTK2CJ) ,VNTK3CJ) ,HOBCJ) .ODEICJ) ,ODE2CJ) ,W0CCJ, 1) ,AND0RCJ) , 

+  WOCCJ, 2), MDRCJ), DMINCJ) 

ENDIF 

DO  110  1110  =  1,J-1 
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IF(OPR(J).EQ.OPR(I110))  THEN 

WRITE(15,*)  ’READOD:  Error  in  input  data  -  Target  ' /rOBJ(J) 
WRITE(15,*)  *  has  same  priority  as  Target  ',TOBJ(I110) 

WRITEdS,*)  'FALCON  STOPPING.  ’ 

V/RITEC*,*)  'READOD:  Error  in  input  data  -  Target  ',T0BJ(J) 
WRITE(*,*)  '  has  same  priority  as  Target  ',T0BJ(I110) 

WRITE (*,*)  'FALCON  STOPPING.  ' 

STOP 
ENDIF 
no  CONTINUE 

IF(OPR(J) .LT. l.OR.OPR(J) .GT.999)  THEN 

WRITEdS,*)  'READOD:  Error  in  input  data  -  Target  '  ,T0BJ(J) 
WRITEdS,*)  '  must  have  priority  between  1  and  999' 

WRITEdS,*)  'FALCON  STOPPING.  ' 

WRITE (*,*)  'READOD:  Error  in  input  data  -  Target  ',TOBJ(J) 
WRITE(*,*)  '  must  have  priority  between  1  and  999' 

WRITE (*,*)  'FALCON  STOPPING.  ' 

STOP 

ENDIF 

IF(TNUM(J).EQ.O)  THEN 
J  =  J  -  1 
GOTO  100 
ENDIF 

TGOFOR(J)  =  TNUM(J) 

IF(MOBT(J).NE. 'M')  PDET(J)  =1.0 
IF(PDET(J).NE.1.0)  TGOFOR(J)  =  INT(TNUM(J)*PDET(J)) 

CNAM  =  W0C(J,1) 

CNAM2  =  WOC(J,2) 

IF(CNAMd:2).EQ.  'g_'  .OR.CNAMd:2)  .EQ.  'd_'.0R. 

+  CNAM2d:2).EQ. 'g_' .OR.CNAM2d:2).EQ. 'd_')  THEN 

WRITE(1S,*)  'READOD:  Error  in  input  data  for  target  ',TOBJ(J) 
WRITE(1S,*)  '  Alert  type  may  not  be  specified  ' 

WRITEdS,*)  '  FALCON  stopping. ' 

WRITE(*,*)  'READOD:  Error  in  input  data  for  target  ',T0BJ(J) 
WRITE (*,*)  '  Alert  type  may  not  be  specified  ' 

WRITE (*,*)  '  FALCON  stopping. ' 

STOP 
ENDIF 
GO  TO  100 

Read  in  all  the  rules  and  setup  information. . . 

300  READ(LINE,3030,ERR=499,END=100)  RULNAM,L1,L2 
310  CONTINUE 

IF(RULNAM.EQ. 'ARATE  ')  AKATE  =  LI 
IF ( RULNAN . EQ . ' AORDER ' )  THEN 
AORDER  =  LI 

IFCLl.NE. '1' .AND.Ll.NE. '2')  THEN 

WRITEdS,*)  'READOD:  Illegal  value  for  AORDER  entered.' 
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WRITE(15,*)  '  AORDER  set  to  default  value,  2.' 

WRITEC*,*)  'READOD:  Illegal  value  for  AORDER  entered.' 

WRITEC*,*)  '  AORDER  set  to  default  value,  2.' 

STOP 

ENDIF 

ENDIF 

IF(RULNAM.EQ. 'CASE  ')  CASE  =  LI 
IFCRULNAM.EQ. 'IPRINT')  THEN 
IPRINT  =  3 

IF(L1.EQ. '0')  IPRINT  =  0 
IFCLl.EQ. '1')  IPRINT  =  1 
IF(L1.EQ. '2')  IPRINT  =  2 
GOTO  100 
ENDIF 

IF(RULNAM.EQ. 'IPRCRX')  THEN 
IFCLl.EQ. '1')  IPRCRX  =  1 
IFCLl.EQ. '2')  IPRCRX  =  2 
GOTO  100 
ENDIF 

IFCRULNAM.EQ. 'TPRINT')  THEN 

READCLINE , 2020 ,END=100)  ITPl . ITP2 
IFCITPl.NE.O)  TPl  =  ITPl 
IFCITP2.NE.0)  TP2  =  ITP2 
GO  TO  100 
ENDIF 

IFCRULNAM.EQ. 'ISSPK  ')  ISSPK  =  LI 
IFCRULNAM.EQ. 'IPLS  ')  IPLS  =  LI 
IFCRULNAM.EQ. 'ARWOC  ')  ARWOC  =  LI 
IFCRULNAM.EQ. 'TSORT  ')  TSORT  =  LI 
IFCRULNAM.EQ. 'IPASS2')  IPASS2  =  LI 
IFCRULNAM.EQ. 'TLSORT')  TLSORT  =  LI  . 

IFCRULNAM.EQ. 'ARLEG  ')  ARLEG  =  LI 
IFCRULNAM.EQ. 'ARSAM  ')  ARSAM  =  LI 

I F  C  RULNAM . EQ . ' PORDER ' )  THEN 
PORDER  =  LI 
P2C1,1)  =  LI 
P2C2,1)  =  L2 
ENDIF 

IFCRULNAM.EQ. 'IDEP')  THEN 
IDEPCD  =  LI 
IDEPC2)  =  L2 
ENDIF 

IFCRULNAM.EQ. 'ARTU')  THEN 
ARTU  =  LI 
P2C1,2)  -  LI 
P2C2,2)  =  L2 
ENDIF 

IF (RULNAM . EQ . ' ARDE ' )  THEN 
ARDE  =  LI 
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P2(l,3)  =  LI 
P2(2,3)  =  L2 
ENDIF 

IF ( RULNAM . EQ . ' ARMOF ' )  THEN 
ARMOF  =  LI 
P2(l,4)  =  LI 
P2(2,4)  =  L2 
ENDIF 

IF (RULNAM . EQ . ' ARFOM ' )  THEN 
ARFOM  =  LI 
P2(l,5)  =  LI 
P2(2.5)  =  L2 
ENDIF 
GO  TO  100 
C 


800  NOBJ  =  J 

IF(NOBJ.EQ.O)  GOTO  399 
C 

C  Set  the  priorities  of  the  objectives... 
CALL  OBPRIO 


DO  500  LU  =  15,16 

IF  (IPRINT.EQ.0.AND.LU.EQ.15)  GO  TO  500 
WRITE (LU, 3003) 

WRITE (LU, 3001)  'TARGET  OBJECTIVES  AND  RULES  DATA:  ' 
WRITE (LU,*) 

DO  505  1505  =  1,ITN 
505  WRITE (LU, 3005)  TLINE(I505) 

CALL  WRITOD(LU) 

WRITE(LU,3006) 

WRITE (LU, 2005)  ' . 

X  ' _ 


+ 

+ 

+ 

+ 

+ 

+ 

+ 

+ 


WRITE (LU, 2005) 

1 

OFF- 

M 

T 

! 

M 

1 

WRITE (LU, 2005) 

t 

1 

SET 

VNTK 

0 

U 

t 

D 

MIN 

t 

WRITE (LU, 2005) 

' PRI  TOBJ 

TNUM 

B  DET  R 

R9' 

'5 

AZM  NMI 

(HD)  HOB 

DEI 

DE2 

W' 

'OCl  A/0  WOC2  G  DE  ' 

WRITE (LU, 2005)  ' . 

I 

I  _  t 


DO  400  K=l.NOBJ 
J  =  IPRIO(K) 

IFdSSPK.EQ.  '2')  THEN 

WRITE(LU,2010)  OPR(J) ,TOBJ(J) ,TNUM(J) ,MOBT(J) ,PDET(J) , 
+  TUR(J),R95(J),AZMTH(J),0FF(J),VNTK1(J),H0B(J),0DE1(J), 

+  ODE2(J) ,WOC(J, 1) ,AND0R(J) ,WOC(J,2) ,MDR(J) ,DMIN(J) 


ELSE 

WRITE (LU, 2000)  OPR(J) ,TOBJ(J) ,TNUM(J) ,M0BT(J) ,PDET(J) , 

+  TUR(J) ,R95(J) ,AZMTH(J) ,OFF(J) ,VNTK1(J) ,VNTK2(J) ,VNTK3(J) , 

+  HOB(J) ,0DE1(J) ,ODE2(J) ,WOC(J, 1) ,ANDOR(J) ,WOC(J,2) ,MDR(J) , 

+  DMIN(J) 

ENDIF 

400  CONTINUE 

WRITE (LU, 2005)  ' . 

j.  ' _ t 


500  CONTINUE 
C 

2000  F0RMAT(5X,I3,2X.A12,2X,I6,3X,A1,2X,F3.1,2X,I1,2(1X,F7.3),1X, 

+  F5.3.1X.I2,A1.A1,2X,I5,2(2X,F3.2),2X,A12,2X,A3,2X,A12,4X,A1, 

+  1X,F4.2) 

2005  FORMAT (5X,A40,A44,A43) 

2010  F0RMAT(5X.I3,2X,A12,2X.I6.3X,A1,2X,F3.1,2X,I1,2(1X,F7.3)  IX, 

+  F5.3.1X,I5,lX,I5,2(2X,F3.2),2X,A12,2X,A3.2X,A12,4X,Al,lX,F4.rO 
2015  FORMAT(A14,A12,A40) 

2020  FORMAT(9X,I3,2X,I3) 

3000  FORMAT(A) 

3001  FORMAT (A34) 

3002  F0RMAT(A10,2X,I2,A1,I2,A1,I4) 

3003  FORMATC///) 

3004  F0RMAT(A10,2X,A80) 

3005  F0RMAT(A70) 

3006  FORMATC////////) 

3007  FORMAT(A10,2X.I2,2(A1,I2)) 

3008  FORMAT (A80) 

3010  F0RMAT(I3,1X,A12,1X,I6.1X,A1,1X,F3.1,1X,I1,2(1X,F7.3),1X,F5.3, 

+  1X.I4,1X,I5,2(2X,F3.2),1X,A12,1X,A3,1X,A12,1X,A1,1X,F4.2) 

3020  F0RMAT(I3,1X,A12,1X,I6.1X,A1,1X,F3.1,1X,I1,2(1X,F7.3),1X,F5.3. 

+  1X,I2,A1,A1,1X,I5,2(2X,F3.2),1X,A12,1X,A3,1X,A12,1X,A1,1X,F4.2) 
3030  F0RMAT(2X,A6,3X,A1,4X,A1) 

C 

CLOSE (2) 

RETURN 

C 

399  WRITE(*,*)  'READOD:  Error  in  reading  targets  data  file  or' 
WRITE(*,*)  '  file  not  found.  FALCON  stopping.' 

STOP 

WRITE(15,*)  'READOD:  Error  in  reading  targets  data  file  or' 
WRITE(15,*)  '  file  not  found.  FALCON  stopping.' 

STOP 

C 

499  WRITE(*,*)  'READOD:  Error  in  reading  targets  data  file.  L' , 

+  ' ine  was :  ' 

WRITE (*,*)  ’  '.LINE 

WRITE(*,*)  'FALCON  stopping.' 

STOP 

WRITE(15,*)  'READOD:  Error  in  reading  targets  data  file.  L' , 
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+  'ine  was:  ' 

WRITE (15,*)  '  ',LINE 

WRITE(15,*)  'FALCON  stopping.' 
STOP 
C 

END 


SUBROUTINE  READWD 

C 

C  READWD  reads  and  stores  the  input  weapons  and  defenses  data. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

CHARACTER* 126  LINE 
CHARACTER*70  TLINE(IO) 

CHARACTER*!  LI 
C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  ’FDNAM.CDE' 

^INCLUDE:  'PRINT. CDE' 

^INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

OPEN(3.FILE=WFNAME) 

C 

I  =  0 
ITN  =  0 
WPMAX  =  0 

100  READ  (3,3000,END=800)  LINE 

IF(LINE(1:10).EQ. '  ')  GOTO  100 

READ(LINE.3000)  LI 

IF(LI.EQ.'C'.OR.LI.EQ.'I')  GOTO  100 
IF(L1.EQ. 'E')  GO  TO  800 
IF(L1.EQ. 'T')  THEN 
ITN  =  ITN  +  1 
IF(ITN.GT.IO)  GO  TO  100 
TLINE(ITN)  =  LINE(2:71) 

GO  TO  100 
ENDIF 
C 

I  =  I+l 

IF(I.GT.NMAX)  THEN 

WRITE (15,*)  'READWD:  Error  in  input  data  -  Too  many  ' 
WRITE(15,*)  '  weapon  types.  Max  allowed:  ',NMAX 

WRITE (15,*)  'FALCON  STOPPING.  ‘ 

WRITE (*,*)  'READWD:  Error  in  input  data  -  Too  many  ' 
WRITE(*,*)  '  weapon  types.  Max  allowed:  ' ,NMAX 

WRITE (*,*)  'FALCON  STOPPING.  ' 

STOP 

ENDIF 

RE AD ( LINE , 30 1 0 , ERR=49 9 , END= 100)  WNAM ( I ) , WCAT ( I ) , WLEG ( I ) , 

+  WPR(I) ,MOBW(I) ,WTU(I) ,NW(I) ,WAV(I) ,NWTH(I) ,PWTH(I) 

READ ( LINE , 30 12 , ERR=49 9 , END= 100)  WAD ( I ) , 

+  WAG(I),PLSS(I,1),PLSS(I,2),PLSS(I,3),PLSS(I,4),RELL(I), 
+  RELI(I),RELW(I),PTPS(I,1),PTPS(I,2),PTPS(I,3),PTPS(I,4) 
READ(LINE,3011,ERR=399,END=100)  YLD(I) ,CEP(I) 

3010  F0RMAT(1X,A8,1X,A4,1X,A1,1X,I3,1X,A1,1X,I1,1X,I4,1X,F4.2, 

+  IX, 14, IX, F4. 2) 
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3012  F0RMAT(44X,13(1X,F4.2)) 

3011  F0RMAT(109X,2(1X,I4)) 

IF(NW(I).EQ.O)  THEN 
1  =  1-1 
GOTO  100 
ENDIF 

DO  no  1110  =  1,1-1 

IF(WPR(I).EQ.WPR(I110))  THEN 

WRITEdS,*)  'READWD;  Warning  -  Weapon  ',WNAM(I) 

WRITE(15,*)  '  has  same  priority  as  Weapon  ',WNAM(I110) 

WRITE(*,*)  'READWD:  Warning  -  Weapon  '.WNAM(I) 

WRITE(*,*)  '  has  same  priority  as  Weapon  ',WNAM(I110) 

ENDIF 
110  CONTINUE 

IF(WPR(I).LT.1.0R.WPR(I).GT.99)  THEN 

WRITEdS,*)  'READWD:  Error  in  input  data  -  Weapon  '.WNAMd) 
WRITE(15,*J  '  must  have  priority  between  1  and  99' 

WRITE (15,*)  'FALCON  STOPPING.  ' 

WRITE(*,*)  'READWD:  Error  in  input  data  -  Weapon  ',WNAM(I) 
WRITE(*,*)  '  must  have  priority  between  1  and  99' 

WRITE(*,*)  'FALCON  STOPPING.  ’ 

STOP 

ENDIF 

IF(WAG(I).LT.WADd))  THEN 

WRITEdS,*)  'READWD:  Error  in  input  data  -  Weapon  ',WNAM(I) 
WRITE d5,*)  '  must  have  generated  alert  rate  greater' 

WRITEdS,*)  '  than  day-to-day  alert  rate.' 

WRITEdS,*)  'FALCON  STOPPING.  ' 

WRITE(*,*)  'READWD:  Error  in  input  data  -  Weapon  ',WNAM(I) 
WRITE(*,*)  '  must  have  generated  alert  rate  greater' 

WRITE(*,*)  '  than  day-to-day  alert  rate.' 

WRITE(*,*)  'FALCON  STOPPING.  ' 

STOP 

ENDIF 

IFCISSPK.EQ.  '2'.AND.CEPd).EQ.0.)  THEN 

WRITEdS,*)  'READWD:  Error  in  input  data  -  CEP  for  ', WNAMd) 
WRITE(15,*)  '  may  not  be  zero  for  calculating  SSPK' 

WRITEdS,*)  'FALCON  STOPPING.  ' 

WRITEC*,*)  'READWD:  Error  in  input  data  -  CEP  for  ', WNAMd) 
WRITE(*,*)  '  may  not  be  zero  for  calculating  SSPK' 

WRITEC*,*)  'FALCON  STOPPING.  ' 

STOP 

ENDIF 

IF((ISSPK.EQ. '3' .OR.ISSPK.EQ. 'S' ) .AND.YLD(I) .EQ.O. )  THEN 
WRITEdS,*)  'READWD:  Error  in  input  data  -  Yield  for  '  ,WNAM(I) 
WRITE(15,*)  '  may  not  be  zero  for  PDCLC4  calculation' 

WRITEdS,*)  'FALCON  STOPPING.  ' 

WRITEC*,*)  'READWD:  Error  in  input  data  -  Yield  for  ',WNAM(I) 
WRITEC*,*)  '  may  not  be  zero  for  PDCLC4  calculation' 

WRITEC*,*)  'FALCON  STOPPING.  ' 

STOP 
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ENDIF 

IF(CASE.EQ. 'P')  THEN 
ISC  =  4 

PLS(I)  =  PLSS(I,4) 

PTP(I)  =  PTPS(I,4) 

IFCARATE.EQ. 'D')  THEN 
ISC  =  2 

PLS(I)  =  PLSS(I,2) 

PTP(I)  =  PTPS(I,2) 

ENDIF 

ELSE 

ISC  =  3 

PLS(I)  =  PLSS(I,3) 

PTP(I)  =  PTPS(I»3) 

IFCARATE.EQ. 'D')  THEN 
ISC  =  1 

PLS(I)  =  PLSSd.l) 

PTP(I)  =  PTPSd.l) 

ENDIF 

ENDIF 

Set  PLS  where  PLS  is  used  to  reduce  allocatable  weapons... 
IF(WPRd).GT.WPMAX)  WPMAX  =  WPRCI) 

GO  TO  100 

800  NWTYP  =  I 

IFCNWTYP.EQ.O)  GOTO  399 


DO  500  LU  =  15,16 

IF  dPRINT.EQ.0.AND.LU.EQ.15)  GO  TO  500 
WRITE (LU, 3003) 

WRITE (LU, 2000)  'WEAPON  DATA: 

WRITE (LU,*) 

DO  505  1505  =  1,ITN 

WRITE (LU, 3005)  TLINE(I505) 

WRITE (LU,*) 

WRITE (LU, 20 15)  '  L  M  U 

I-  '  PLS  PLS  PLS  PLS 

h  '  PTP  PTP  PTP  PTP  ' 


WRITE (LU, 20 15)  '  E  0  R  WITHHO 

'LD  ALERT  DAY  DAY  GEN  GEN  RELIABILITIES 
'  DAY  DAY  GEN  GEN  ' 

WRITE(LU,2015)  '  NAME  TYPE  G  PRI  B  G  DEP  AVAIL  WN  W 
'P  DAY  GEN  DEL  PRL  DEL  PRL  RELL  RELI  RELW 
'  DEL  PRL  DEL  PRL  YLD  CEP  ' 

WRITE (LU, 20 15)  '  . 


DO  210  J  =  1, WPMAX 
DO  210  I  =  1, NWTYP 

IF(WPR(I).NE.J)  GOTO  210 

WRITE(LU,2010)  WNAM(I) ,WCAT(I) ,WLEG(I) ,WPR(I) ,MOBW(I) , 
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+  WTU(I) ,NW(I) ,WAV(I) ,NWTH(I) ,PWTH(I) ,WAD(I) , 

+  WAG(I),PLSS(I,1),PLSS(I,2),PLSS(I,3),PLSS(I,4), 

+  RELL(I) ,RELI (I) ,RELW(I) ,PTPS(I , 1) ,PTPS(I ,2) , 

+  PTPS(I,3),PTPS(I,4),YLD(1),CEP(I) 

210  CONTINUE 
500  CONTINUE 
C 

2000  F0RMAT(A18) 

2010  F0RMAT(3X.A8,1X,A4,1X,A1,1X,I3,1X,A1,1X,I1,1X,I4,1X, 

+  F4.2,lX,I4,lX,F4.2,13(iX,F4.2),2(lX,I4)) 

2015  F0RMAT(A44,A47,A30) 

3000  FORMAT(A) 

3003  FORMAT(///) 

3005  FORMAT(1X,A70) 

C 

CLOSE (3) 

RETURN 

C 

399  WRITE (*,*)  'READWD:  Error  in  reading  weapons  data  or  ' 
WRITE(*,*)  '  file  not  found.  FALCON  stopping.' 

STOP 

WRITE(15,*)  'READWD:  Error  in  reading  weapons  .data  or  ' 
WRITE(15,*)  '  file  not  found.  FALCON  stopping.' 

STOP 

C 

499  WRITE(*,*)  'READWD:  Error  in  reading  weapons  data  file.  L' , 
+  'ine  was:  ' 

WRITE(*,*)  '  ',LINE 

WRITE(*,*)  'falcon  stopping.' 

STOP 

WRITE(15,*)  'READWD:  Error  in  reading  weapons  data  file.  L' , 
+  ' ine  was:  ' 

WRITE(15.*)  '  '.LINE 

WRITE (15,*)  'FALCON  stopping.' 

STOP 

C 

END 
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SUBROUTINE  REINIT 

c 

IMPLICIT  INTEGER*4  (I-N) 

REINIT  initializes  the  ALLOC  arrays  for  the  second  pass... 

This  is  done  by  adding  a  null  element  into  the  NDXA  arrays 
for  the  objectives  where  there  are  targets  which  are  unhit... 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'RULES. CDE' 

C 

C  Check  for  untargeted  targets...  If  the  current  objective  has 
C  no  allocations,  make  roo...  for  new  allocations  after  the  last 
C  allocation  of  the  previous  objective.  If  the  previous  objective 
C  had  no  allocations,  make  room  in  the  ALLOC  arrays  after  the  last 
C  allocation  of  the  objective  before  the  previous  one,  etc... 

C 

IF(TG0F0R(IC0)  NE.O)  THEN 
IB  =  0 

IF(ICOP.GT.l)  THEN 
DO  100  I  =  1,IC0P"1 
IB  =  INDX(IC0P-I,2) 

IF(IB.NS.O)  GOTO  110 
100  CONTINUE 

ENDIF 

110  CALL  ABUMP(IB) 

ENDIF 

C 

RETURN 

C 
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SUBROUTINE  REQDE 


C 

C  REQDE  checks  the  DE  REQuirement  of  weapons  against  the 
C  current  objective.  The  flag  ICON!  is  set  according  to  the 
C  following  outcomes: 

C  ICONT  =  0  -  no  weapons  was  found  which  meets  the 

C  DE  requirement 

C  ICONT  =  1  -  No  weapon  was  found  which  meets  the  DE 

C  requirement  but  this  requirement  can  be  relaxed. 

C  Continue  with  weapon  selection. 

C  ICONT  =  2  -  A  weapon  was  found  v;hich  meets  the  DE 

C  requirement,  continue  with  weapon  selection. 

C 


IMPLICIT  INTEGER*4  (I-N) 
C 

$  INCLUDE;  'AWEAPS.CDE' 

$ INCLUDE;  'OBJ.CDE' 

$ INCLUDE:  ' PRINT. CDE' 

$  INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$  INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 


ICONT  =  0 
C 

C  Does  anything  meet  the  DE  requirement?... 

DO  100  I  =  1,NSALL 

IF(DE(IC0,IDXSA(I)).GE.0DE1(IC0))  THEN 
ICONT  =  2 
GOTO  1000 
ELSE 

C  If  nothing  meets  the  requirement,  see  if  the  requirement 
C  can  be  relaxed. . . 

IF(ARDE.EQ. '2')  ICONT  =  1 
ENDIF 
100  CONTINUE 


C 

1 00 0  I F ( I PR I NT . NE . 0 . AND . OPR ( I CO ) . GE . TP 1 . AND . OPR ( I CO ) . LE . TP2 )  THEN 
IF ( ICONT. EQ.O)  THEN 
WRITE(15,*) 

WRITE (15,*)  'REQDE:  Weapon(s)  meeting  the  DE', 

+  '  requirement  are  not  available' 

WRITE(15,*)  '  for  allocation  and  the  DE', 

+  '  requirement  can  not  be  relaxed  -  ' 

ENDIF 

IF ( ICONT. EQ.l)  THEN 
WRITE (15,*) 

WRITE(15,*)  'REQDE:  Weapon(s)  meeting  the  DE', 

+  '  requirement  are  not  available' 

WRITE(15,*)  '  for  allocation  but  the  DE', 

+  '  requirement  can  be  relaxed  -  ' 
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C 

C 


ENDIF 

ENDIF 

RETURN 

END 
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SUBROUTINE  REQDE2(IDLOW) 

C 

C  REQDE2  checks  the  DE  REQuirement  of  weapons  in  Pass  2  against  the 
C  current  objective.  IDLOW  is  the  index  of  the  current  weapon  allocation. 
C  The  flag  ICONT  is  set  according  to  the  following  outcomes: 

C  ICONT  =  0  -  no  weapon  was  found  which  meets  the 

C  DE  requirement 

C  ICONT  =  1  -  No  weapon  was  found  which  meets  the  DE 

C  requirement  but  this  requirement  can  be  relaxed. 

C  Continue  with  weapon  selection. 

C  ICONT  =  2  -  A  weapon  was  found  which  meets  the  DE 

C  requirement,  continue  with  weapon  selection. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'PRINT. CDE' 

$  INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

ICONT  =  0 
C 

C  Does  anything  meet  the  DE  requirement? . . . 

IDX2  =  AWTVP ( IDLOW, 1) 

IF(IDX2.EQ.O)  IDX2  =  AWTYP(IDL0W,2) 

DO  100  I  =  l.NSALL 

DEX  =  1.”  (1.-DE(IC0,IDX2))*(1.-DE(IC0,IDXSA(I))) 
IF(DEX.GE.0DE1(IC0))  THEN 
ICONT  =  2 
GOTO  1000 
ELSE 

C  If  nothing  meets  the  requirement,  see  if  the  requirement 
C  can  be  relaxed. . . 

IF(ARDE.EQ. '2')  ICONT  =  1 
ENDIF 
100  CONTINUE 
C 

1 000  I F ( I PRI NT . NE . 0 . AND . OPR ( ICO ) . GE . TP 1 . AND . OPR ( ICO ) . LE . TP2 )  THEN 
IF ( ICONT. EQ.O)  THEN 
WRITE(15,*) 

WRITE(15,*)  'REQDE2:  Weapon(s)  meeting  the  DE', 

+  '  requirement  are  not  available' 

WRITE(15,*)  '  for  allocation  and  the  DE', 

+  '  requirement  can  not  be  relaxed  -  ' 

ENDIF 

IF ( ICONT. EQ.l)  THEN 
WRITE(15,*) 
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WRITE(15,*)  'REQDE2:  Weapon(s)  meeting  the  DE', 
+  '  requirement  are  not  available' 

WRITE(15,*)  '  for  allocation  but  the  DE', 

+  '  requirement  can  be  relaxed  -  * 

ENDIF 

ENDIF 

RETURN 

END 


SUBROUTINE  REQLEG(IDLOW) 


C 

C  REQLEG  checks  the  LEG  REQuirement  of  weapons  against  the 
C  current  objective.  IDLOW  is  the  index  of  the  current  weapon 
C  allocation.  The  flag  ICONT  is  set  according  to  the  following  outcomes 
C  ICONT  =  0  -  no  weapons  are  available  which  meet  the 

C  leg  requirement 

C  ICONT  =  1  -  No  weapon  was  found  which  meets  the  leg 

C  requirement  but  this  requirement  can  be  relaxed. 

C  Continuing  with  selection  of  weapon 

C  ICONT  =  2  -  A  weapon  was  found  which  meets  the  leg 

C  requirement,  continue  with  weapon  selection 

C 

IMPLICIT  INTEGERS  (I-N) 

C 

CHARACTER* 1 0  CNAM , CNAM2 
C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'AWEAPS.CDE' 

$INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'PRINT. CDE' 

$  INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEARS. CDE' 

C 

ICONT  =  0 
C 

C  Does  anything  meet  the  leg  requirement  (i.e.  is  there  a  weapon  from 
C  a  different  leg  as  that  allocated  in  Pass  1?)... 

IDX  =  AWTYPdDLOW.l) 

IF(IDX.EQ.O)  IDX  =  AWTYP(IDL0W,2) 

CNAM2  =  WNAM(IDX) 

DO  100  I  =  l.NSALL 

IF ( WLEG ( IDXSA ( I ) ) . NE . WLEG ( IDX) )  THEN 
ICONT  =  2 
GOTO  1000 
C 

ELSE 

C  If  nothing  meets  the  requirement,  see  if  the  requirement 
C  can  be  relaxed. . . 

IF(ARLEG.EQ. '2')  THEN 
CNAM  =  WNAMdDXSAd)) 

C  Requirement  can  be  relaxed,  see  if  the  available  weapon  is 
C  the  same  weapon.  If  so,  see  if  requirement  can  be  relaxed... 

IF(CNAM(2:10).EQ.CNAM2(2:10))  THEN 
IF(ARSAM.EQ. '2')  ICONT  =  1 
IF(ARSAM.NE. '2')  ICONT  =  0 
ELSE 

ICONT  =  1 
END  IF 
EHDIF 
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ENDIF 
100  CONTINUE 
C 

1000  IF(IPRINT.NE.O.AND.OPR(IGO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
IF(ICONT.EQ.O)  THEN 
WRITE  (l-S*) 

WRITE(15,*)  'REQLEG:  Weapon(s)  from  a  different  leg', 

+  '  than  the  Pass  1  allocation' 

WRITE(15,*)  '  are  not  available  and  this  ru', 

+  ' le  can  not  be  relaxed  -  ' 

ENDIF 

IF(ICONT.EQ.l)  THEN 
WRITE (IS,*) 

WRITE(15,*)  'REQLEG:  Weapon(s)  from  a  different  leg', 

+  '  than  the  Pass  1  allocation' 

WRITE(15,*)  '  are  not  available  but  this  ru', 

+  'le  can  be  relaxed  -  ' 

ENDIF 

ENDIF 

C 

RETURN 

C 

END 


SUBROUTINE  REQMOB 


C 

C  REQMOB  checks  the  MOBility  REQuirement  of  weapons  against 
C  current  objective.  The  flag  ICONT  is  set  according  to  the 
C  following  outcomes: 

C  ICONT  =  0  -  no  weapon  was  found  which  meets  the 

C  mobility  requirement 

C  ICONT  1  -  No  weapon  was  found  which  meets  the  mobility 

C  requirement  but  this  requirement  can  be  relaxed. 

C  Continuing  with  weapon  selection... 

C  ICONT  =  2  “  A  weapon  was  found  which  meets  the  mobility 

C  requirement;  continue  with  weapon  selection 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  'AWEAPS.CDE* 

$ INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' PRINT. CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

ICONT  =  0 
C 

C  If  the  target  is  mobile,  see  if  there  are  mobile  weapons... 
IF(MOBT(ICO).EQ. 'M')  THEN 
DO  100  I  =  l.NSALL 

IF(MOBW(IDXSA(I)).EQ. 'M')  THEN 
ICONT  =  2 
GOTO  1000 

C  If  no  mobile  weapons,  see  if  requirement  can  be  relaxed... 

ELSE 

IF(ARFOM.EQ. '2')  ICONT  =  1 
ENDIF 

100  CONTINUE 
C 

C  If  the  target  is  fixed,  see  if  there  are  non-mobile  weapons... 
ELSE 

DO  200  I  =  1,NSALL 

IF(MOBW(IDXSA(I)).NE. 'M')  THEN 
ICONT  =  2 
GOTO  1000 

C  If  no  non-mobile  weapons,  see  if  requirement  can  be  relaxed... 
ELSE 

IF(ARM0F.EQ. '2')  ICONT  =  1 
ENDIF 

200  CONTINUE 
C 

ENDIF 

C 

1000  CONTINUE 
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C 

C 


IF( IPRINT . NE . 0 . AND . OPR( ICO) . GE .TPl . AND. OPR(ICO) . LE . TP2)  THEN 
IF(ICONT.EQ.O)  THEN 
WRITE (15,*) 

WRITE(15,*)  'REQMOB:  Weapon(s)  meeting  the  mobility', 

+  '  requirement  are  not  available' 

WRITE(1S,*)  '  for  allocation  and  the  mobility', 

+  '  requirement  can  not  be  relaxed  -  ' 

ENDIF 

IF(ICONT.EQ.l)  THEN 
WRITE (15,*) 

WRITE(15,*)  'REQMOB:  Weapon(s)  meeting  the  mobility', 

+  '  requirement  are  not  available' 

WRITE(15,*)  '  for  allocation  but  the  mobility', 

+  '  requirement  can  be  relaxed  -  ' 

ENDIF 

ENDIF 

RETURN 
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SUBROUTINE  REQTIM 

C 

C  REQTIM  checks  the  TIMing  REQuirement  of  weapons  against  the 
C  current  objective.  The  flag  ICONT  is  set  according  to  the 
C  following  outcomes; 

C  ICONT  =  0  -  no  weapon  was  found  which  meets  the 

C  timing  requirement 

C  ICONT  =  1  -  No  weapon  was  found  which  meets  the  timing 

C  requirement  but  this  requirement  can  be  relaxed, 

C  Continuing  with  selection  of  weapon 

C  ICONT  =  2  -  A  weapon  was  found  which  meets  the  timing 

C  requirement,  continue  with  weapon  selection 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' PRINT. CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

ICONT  =  0 
C 

C  Does  anything  meet  the  timing  requirement?... 

DO  100  I  =  l.NSALL 

IF (WTU ( IDXSA ( I ) ) . LE . TUR ( ICO) )  THEN 
ICONT  =  2 
GOTO  1000 
ENDIF 
100  CONTINUE 

C  If  nothing  meets  the  requirement,  see  if  the  requirement 
C  can  be  relaxed. . . 

IFCARTU.EQ. '2')  ICONT  =  1 
C 

1000  IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
IF(ICONT.EQ.O)  THEN 
WRITEdS,*) 

WRITE(15,*)  'REQTIM:  Weapon(s)  meeting  the  timing', 

+  '  requirement  are  not  available' 

WRITE(15,*)  '  for  allocation  and  the  timing', 

+  '  requirement  can  not  be  relaxed  -  ' 

ENDIF 

IF(ICONT.EQ.l)  THEN 
WRITEdS,*) 

WRITECIS,*)  'REQTIM:  Weapon(s)  meeting  the  timing', 

+  '  requirement  are  not  available' 

WRITE(15,*)  '  for  allocation  but  the  timing', 

+  '  requirement  can  be  relaxed  -  ' 

ENDIF 

ENDIF 
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C 

C 


RETURN 

END 


SUBROUTINE  REQWOC 


c 

C  REQWOC  check  the  REQuireraent  for  a  WOC  for  the 
C  current  objective.  If  the  weapon  (or  weapons)  specified 
C  are  available,  these  are  stored  in  lUSE(l)  and,  if 
C  appropriate,  IUSE(2).  The  flag  ICONT  (in  AWEAPS  common) 

C  is  set  according  to  the  following  outcomes: 

C  ICONT  =  0  -  no  WOC  available  and  WOC  requirement  can 

C  not  be  relaxed 

C  ICONT  =  1  -  No  weapons  of  choice  available  but 

C  weapon  of  choice  requirement  can  be  relaxed 

C  OR  no  weapon  of  choice  selected  -  return 

C  for  default  weapon  selection 

C  ICONT  =  2  -  WOC  found,  continue  to  allocation 

C 

IMPLICIT  INTEGERS  (I-N) 

C 

$ INCLUDE:  ’ AWEAPS. CDE' 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

ICONT  =  0 
lUSE(l)  =  0 
IUSE(2)  a  0 
C 

C  Determine  whether  there  are  no,  one  or  two  weapons  of  choice. 

C  If  none,  return  to  FALCON  to  select  weapon  from  list  of  all 
C  allowable  weapons .. . 

C 

IF(W0C(IC0,1).EQ. '  ')  THEN 

ICONT  =  1 
GO  TO  1010 
END  IF 
C 

C  If  a  single  WOC  selection  only,  see  that  it  is  available... 

C 

IF(AND0R(IC0).EQ. '  ')THEN 

INDEX  =  1 
INDXI  =  1 

CALL  SW0C( INDEX., INDXI) 

IF(IUSE(INDXI).NE.O)  THEN 
ICONT  =  2 
GOTO  1000 
ELSE 

C  If  nothing  available,  see  if  requirement  can  be  relaxed. . 

IF (ARWOC . EQ . ' 2 ' )  ICONT  =  1 
ENDIF 
C 

C  If  an  'OR'  weapon  specified,  see  if  either  available... 
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ELSEIF(AND0R(IC0).EQ.'0R  ')  THEN 
DO  100  I  =  1,2 
INDEX  =  I 
INDXI  =  1 

CALL  SWOC( INDEX, INDXI) 

IF(IUSE(INDXI).NE.O)  THEN 
ICONT  =  2 
GOTO  1000 
ENDIF 
100  CONTINUE 

C  If  nothing  available,  see  if  requirement  can  be  relaxed... 

IF(ARWOC.EQ. '2')  ICONT  =  1 
C 

C  If  pair  is  specified,  see  is  both  are  available.  If  so, 

C  use  the  first  and  last  weapons  in  the  list... 

ELSE 

DO  200  I  =  1,2 
INDEX  =  I 
INDXI  =  I 

CALL  SW0C( INDEX. INDXI) 

IF (IUSE( INDXI ).NE.0)  THEN 
ICONT  =  2 
GOTO  200 
ELSE 

C  If  nothing  available,  see  if  requirement  can  be  relaxed... 

IF(ARW0C.EQ.'2')  THEN 
ICONT  =  1 
GOTO  1000 
ENDIF 
ENDIF 
200  CONTINUE 
ENDIF 
C 

1000  IF ( I PRINT . NE . 0 . AND . OPR ( ICO) . GE . TPl . AND . OPR ( ICO) . LE . TP2 )  THEN 
WRITE (15,*) 

WRITE (15,*)  'REQWOC:  Weapons  of  choice  are:  ', 

+  W0C(IC0,1),'  ’.ANDORdCO),'  ',W0C(IC0,2) 

IF(IUSE(l).NE.O)  THEN 

WRITE(15,*)  '  Weapon(s)  selected  for  allocation:  ', 

+  WNAMdUSEd)) 

ENDIF 

IF(IUSE(2).NE.O)  WRITE(15,*)  '  ' ,WNAM(IUSE(2)) 

IF ( ICONT. F.Q.O)  THEN 

WRITE(15,*)  '  Weapon(s)  of  choice  are  not  availab', 

+  'le  for  allocation  ' 

WRITE (15,*) 

+  '  and  woe  requirement  can  not  be  relaxed  -  ' 

ENDIF 

IF (ICONT. EQ.l)  THEN 

WRITE(15,*)  '  Weapon(s)  of  choice  are  not  availab', 

+  'le  for  allocation  ' 
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WRITE (15,*) 

+  '  but  woe  requirement  has  been  relaxed 

ENDIF 
.  ENDIF 
C 

1010  RETURN 
C 

END 


SUBROUTINE  ROUT2A(LU) 

c 

C  R0UT2A  displays  the  goals  achieved  vs  the  desired  objectives 
C  in  summary  format  for  the  allocation  scenario  only.  LU  is  the 
C  logical  unit  to  which  output  is  sent. 

C 

IMPLICIT  INTEGER*4  (I-N) 

INTEGER*2  LU 


C 

$ INCLUDE:  ' ALLOC. CDE' 
$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PDES.CDE' 

$ INCLUDE:  'PRIO.CDE' 
i INCLUDE:  'RULES. CDE' 
$ INCLUDE:  'TARGT.CDE' 
C 


WRITE (LU, 3035) 

WRITE(LU,3040)  '  DAMAGE  ACHIEVED  BY  TA 

+  'RGET  OBJECTIVE 

WRITE(LU,3040)  '|  MT 

+  •  I' 

WRITE(LU,3040)  '|  TARGET  OU  VNTK  GOA 

+  'L  DE  NOT  1 ' 

WRITE  (LU,  3040)  '1  PRI  NAME  .NUMBER  B  R  (HD)  PASS  1 

+  '  PASS  2  TARGETED  PASS  1  PASS  2  | ' 

WRITE (LU, 3040)  '| . 

j.  ' _ I  • 


DO  100  K1  =  1,N0BJ 

ICO  =  IPRIO(Kl) 
K  =  ICO 


ICOP  =  K1 
CALL  ROUT23 
IB  =  INDX(K1,1) 

IE  =  INDX(K1,2) 

DEX  =  0 

IF(IB.NE.O)  THEN 

DO  201  1201  =  IB, IE 

IF(AWTYP(I201,1).EQ.0)  GOTO  201 
IF(AWTYP(I201,2).EQ.0)  THEN 
DEX  =  DEI (1201) 

ELSE 

CALL  SCNDE3 ( AWTYP ( I 20 1 , 1 ) , I SC , DEX) 

ENDIF 

201  CONTINUE 

ENDIF 

IF(MDR(K).EQ. .AND.DEX.LT.ODEl(K)) 

+  SDE(K,ISC,1)  =  SDE(K,ISC,2) 

IF(ARATE.EQ. 'G')  NOHIT  =  NOHIT2(K) 

IF(ARATE.EQ. 'D')  NOHIT  =  NOHITl(K) 

IFdSSPK.EQ. '2')  THEN 

WRITE(LU,3012)  OPR(K) ,TOBJ(K) ,TNUM(K) ,M0BT(K) ,TUR(K) , 


-  208  - 


C 


+  VNTKl(K) ,0DE1(K) ,0DE2(K) ,N0ilIT,SUE(K, ISC, 1) ,SDE(K,ISC,2) 

ELSE 

WRITE(LU,3010)  OPK(K) ,TOBJ(K) ,TNUM(K) ,MOBT(K) .TUR(K) , 
+  VNTKl(K) ,VNTK2(K) ,VN1’K3(K) ,0DE1(K) ,0DE2(K) , NOHIT, 

+  SDE(K,ISC,1),SDE(K,ISC,2) 

END  IF 

100  CONTINUE 


WRITE  (LU  ,  3040  )  '***?’f*Vf*»V5V***Vf***VfVf*VrVfVf*VfA*5VVr*v'r*****vVVf.V*-.'f.V**Vf  '  ^ 


WRITECLU,*) 

C 

3010  FORMAT(25X,' I ' , IX, 13, 1X,A12, 1X,I6, 1X,A1 , IX, II ,2X, I2,A1 ,A1 ,4X, 
+  F4.3,3X,F4.3,8X,I4,5X,F4.3,4X,F4.3,2X,' I ') 

3012  FORMAT(25X,' I ' , IX, 13, 1X,A12, 1X,I6, 1X,A1 ,3X, 1 1 ,2X, 15 , 1X,F4. 3, 

+  3X,F4.3,8X,I4,5X,F4.3,4X,F4.3,2X,' 1') 

3035  FORMATC///) 

3040  FORMAT(25X,A44,A38) 

C 

RETURN 

C 

END 


SUBROUTINE  ROUT2B(LU) 

C 

C  R0UT2B  continues  the  allocation  display,  writing  the  summary  tables 
C  for  the  allocation  scenario  only.  LU  is  the  logical  unit  to  which 
C  output  is  sent. 

C 

IMPLICIT  INTEGERS  (I-N) 

C 

CHARACTER*3  STR , STRC ( 5 ) 

INTEGER*2  LU 

DIMENSION  DNSUM(5,3) ,ISUM(5,3) ,IT0T(3) ,D0(3) , 

+  DSS(5,3,3),DZ(3),DET(3,3) 

C  Note:  in  the  DSS(I,J,K)  array,  I  is  for  the  target  category, 

C  J  is  for  total,  fixed  or  mobile  and  K  is  for  the  current  scenario 

C  as  well  as  the  old  DESUM  (K=2)  and  DGSUM  (K=3).  In  DZ(I),  i  is  for 

c  total,  fixed  and  mobile.  In  DET(I,J)  I  is  for  total,  fixed  and  mobile, 

C  and  J  is  for  the  current  scenario  as  well  as  for  the  old  DEs  and  DGs. 

C  ITOT(I)  are  totals  FOR  total,  fixed  and  mobile. 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'PDES.CDE' 

$  INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'TARGT.CDE' 

$  INCLUDE;  'WEAPS.CDE' 

C 

DATA  STRC  /'NUC' , 'LDR' , 'OMT' , 'ECN' , 'DEF'/ 

C 

C  Write  out  summaries  of  DEs... 

DO  155  I  =  1,5 

DO  155  1155  =  1,3 
DNSUM(I,I155)  =  0. 

DO  155  J155  =  1,3 
155  DSS(I,I155,J155)  =  0. 

C 

DO  200  I  =  l.NOBJ 
IB  =  INDX(I,1) 

IE  =  INDX(I,2) 

STR  =  TOBJ(I) 

DO  200  J  =  1.5 

IF(STR.EQ.STRC(J))  THEN 
DEADD  =  DENEW(I) 

DEX  =  0 

IF(IB.NE.O)  THEN 

DO  201  1201  =  IB, IE 

IF(AWTYP(I201,1).EQ.0)  GOTO  201 
IF(AWTYP(I201,2).EQ.0)  THEN 
DEX  =  DEI (1201) 

ELSE 

CALL  SCNDE3(AWTYP(I201 , 1) , ISC ,DEX) 
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ENDIF 

201  CONTINUE 

ENDIF 

IF(DEADD.EQ.O.AND.IB.NE.O)  DEADD  =  DEX 
DES  =  SDE(I,ISC,2) 

DSS(J,1,1)  =  DSS(J,1,1)  +  DES*TNUM(I) 

DSS(J,1,3)  =  DSS(J,1,3)  +  0DE2(I)*TNUM(I) 

DSS(J,1,2)  =  DSS(J,1,2)  +  DEADD*TNUM(I) 

DNSUM(J,1)  =  DNSUM(J,1)  +  TNUM(I) 

IF(MOBT(I).EQ. 'M')  THEN 

DSS(J,3,3)  =  DSS(J,3,3)  +  0DE2(I)*TNUM(I) 

DSS(J,3,2)  =  DSS(J,3,2)  +  DEADD*TNUM(I) 

DNSUM(J,3)  =  DNSUM(J.3)  +  TNUM(I) 

DSS(J,3,1)  =  DSS(J,3,1)  +  DES*TNUM(I) 

ELSE 

DSS(J,2,3)  =  DSS(J,2,3)  +  0DE2(I)*TNUM(I) 

DSS(J,2,2)  =  DSS(J,2,2)  +  DEADD*TNUM ( I ) 

DNSUM(J,2)  =  DNSUM(J,2)  +  TNUM(I) 

DSS(J,2,1)  =  DSS(J,2,1)  +  DES*TNUM(I) 

ENDIF 
ENDIF 

200  CONTINUE 
C 

DO  210  I  =  1,5 

DO  222  J222  =1,3 
D0(J222)  =  0. 

DZ(J222)  =  0. 

IF(DNSUM(I,J222).NE.0)  DZ(J222)  = 

+  DSS(I,J222,1)/DNSUM(I,J222) 

222  CONTINUE 
C 

DO  302  1302  =2,3 
DO  302  J302  =1,3 
IF(DNSUH(I,J302).NE.0) 

+  D0(J302)  =  DSS(I,J302,I302)/DNSUM(I,J302) 

DSS(I,J302,I302)  =  D0(J302) 

302  CONTINUE 

C 

DO  223  1223  =  1,3 

DSS(I, 1223,1)  =  DZ(I223) 

223  CONTINUE 
210  CONTINUE 

C 

DO  212  1212  =  1,3 
ITOT(I212)  =  0 
DO  212  J212  =  1,3 

212  DET(I212,J212)  =  0 

C 


WRITE (LU, 3005) 
WRITE (LU, 3010) 


'********************************  damage  sum' 


'MARY  BY  TARGET  GROUP  AND  TARGET  MO', 
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+  'BILITY  ***********^v  *5V***VrVf******5Mr**'!VVr?V** ' 

WRITE(LU,3010)  '| 


WRITE (LU, 30 10) 


WRITE (LU, 30 10) 


WRITE(LU,3010) 


WRITE(LU,3010) 


WRITE(LU,3010) 


I . FIXED  TARGETS 

.  MOBILE  TARGETS  . ' 

. TOTAL  TARGETS . | ' 

I  NUMBER  PASS  2 

NUMBER  PASS  2  PASS  2' 
NUMBER  PASS  2  PASS  2  | ' 

I  TARGET  OF  AVG  DE 

OF  AVG  DE  AVG  DE' 

OF  AVG  DE  AVG  DE  1 ' 

1  GROUP  TARGETS  GOAL 

TARGETS  GOAL  ACHIEVE' 
TARGETS  GOAL  ACHIEVED  | ' 


PASS  2  ', 


AVG  DE  ' , 


ACHIEVED' , 


DO  220  I  =  1,5 

DO  221  1221  =  1,3 

ISUM(I,I221)  =  DNSUM(I,I221) 

IT0T(I221)  =  IT0T(I221)  +  DNSUM(I , 1221) 

DO  221  J221  =  1,3 
DET(I221,J221)  =  DET(I221 ,J221)+ 

»•  ISUM(I,I221)*DSS(I,I221,J221) 


221  CONTINUE 


WRITE (LU, 3000)  ' 1 ' ,STRC(I) ,ISUM(I ,2) ,DSS(I ,2,3) ,DSS(I ,2, 1) , 
'I ' ,ISUM(I,3),DSS(I,3,3),DSS(I,3,1),' I ',ISUM(I,1), 
DSS(I,1,3),DSS(I,1,1),' I ' 


220  CONTINUE 


DO  500  1500  =1,3 
DO  500  J500  =1,3 

IF(ITOT(I500).NE.O)  THEN 

DET(I500,J500)  =  DET(I500, J500)/ITOT(I500) 
ELSE 

DET(I500,J500)  =  0. 

END  IF 
500  CONTINUE 

WRITE(LU,3010)  '| . . 

+  ' . . 


WRITE(LU.3025)  '['.'ALL  TARGETS ', IT0T(2) ,DET(2 , 3) ,DET(2 , 1) , 

+  'I' ,IT0T(3),DET(3,3),DET(3,l),’i',IT0T(l),DET(l,3),DET(l,l),' I ' 


WRITE (LU, 30 10)  '* 
+  '* 


A*  1 


3000  F0RMAT(7X,A1,3X,A3,6X,3(3X,I5,6X,F4.3,6X,F4.3,6X,A1)) 
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3005  FORMATC///) 

3010  FORMAT (7X,A43,A34,A41) 

3025  F0RMAT(7X,A1,1X,A11,3(3X,I5,6X,F4.3,6X,F4.3,6X,A1)) 
C 

RETURN 

C 

END 
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SUBROUTINE  ROUT20(LU) 

C 

C  R0UT20  displays  the  summary  allocation  of  weapons  used  against 
C  targets  by  weapon  type  and  triad  leg.  LU  is  the  logical  unit 
C  to  which  output  is  sent. 

C 

IMPLICIT  INTEGERS  (I-N) 

C 

CHARACTER*!  LC0MP(3) 

CHARACTER*3  0NAM(5) 

CHARACTER*5  LNAM(3) 

CHARACTER* 12  TTNAM 
INTEGER*2  LU 

REAL  lAVS , IWHS , lARS , lALL, ISALL, lUALL, ISURV 
C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'PRIO.CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  NT0T(6) ,NT0TT(6) ,S(6) ,IS(6) 

DATA  LCOMP  /'l' , 'S' , 'A'/ 

DATA  LNAM  /'ICBM  ','SLBM  ','AIR  '/ 

DATA  ONAM  /'NUC' , 'LDR' , 'OMT' , 'ECN* , 'DEF'/ 

C 

IDEPS  =  0 
lAVS  =  0. 

IWHS  =  0. 
lARS  =  0. 

ISALL  =  0. 

IALL  =  0. 
lUALL  =  0. 

C 

WRITE (LU, 3025) 

WRITE  (LU,  3020)  '***Vj**-,v******»v?v*******a*******  SUMMARY  AL' , 

+  'LOCATION  OF  WEAPONS  BY  WEAPON  TYPE  *****Vf******** ' , 

^  Vf  «V  V?  Vf  Vf  ^  'f*  Vf  V*  Vf  ^ 

IFdPLS.EQ. '2')  THEN 

WRITE  (LU,  3020)  '|  . LOSSES-—', 

r  ' -  ALLOCATION 

)•  '  I' 

WRITE(LU,3020)  'i  TRIAD  DE-  NOT  WITH-  ', 

•r  'NOT  ALLOCAT . TARGET  GROUP . ', 

+  ' -  UNAL-  r 

WRITE(LU,3020)  '|  LEG  PLOYED  AVAIL  HELD  A', 

+  'LERT  ABLE  NUC  LDR  OMT  ECN  DEF  T', 

+  'OTAL  LOCATED  |' 

ELSE 
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C 


C 


C 


C 


C 


WRITE (LU, 3020)  '| 

t 


WRITE (LU, 3020)  '|  TRIAD 
+  'NOT  ALLOCAT- 

+  ' -  UNAL- 

WRITE(LU,3020)  '|  LEG 
+  'SURV  ABLE 

+  'OTAL  LOCATED 

ENDIF 

WRITE (LU, 3020)  '| . 

j.  ' _ 


. LOSSES . 

ALLOCATION  ' , 

DE-  NOT  WITH-  NOT  ', 

. TARGET  GROUP . ' , 

PLOYED  AVAIL  HELD  ALERT  ' , 
NUC  LDR  OMT  ECN  DEF  T' , 


9 

I 


9 


DO  40  I  =  1,6 
40  NTOTT(I)  =  0 

DO  100  ILEG  =1,3 
DO  50  INIT  =1,6 
S(INIT)  =  0. 

ISURV  =  0. 

50  NTOT(INIT)  =  0 

DO  no  1100  =  l.WPMAX 

DO  no  i:-i,NWTyp 

IF(WPR(I).NE.I100.0R.WLEG(I).NE.LCOMP(ILEG))  GOTO  110 
IF ( ARATE . EQ . ' G ' . AND . AORDER . EQ . ' 1 ' . 

+  AND.I.GT.NWTYP/2)  GOTO  110 

IN  =  I  +  NWTYP/2 

S(3)  =  S(3)  +  AINVWL(I) 

S(4)  =  S(4)  +  AINVRL(I) 

ISURV  =  ISURV  +  AINVNS(I) 
lOBJT  =  0 

IWHS  =  IWHS  +  AINVWL(I) 
lARS  =  lARS  +  AINVRL(I) 

IFdPLS.EQ. '1')  ISALL  =  ISALL  +  AINVNS(I) 

IF (ARATE . EQ . ' G ' . AND . AORDER . EQ . ' 1 ' )  THEN 
S(l)  =  NW(I)  +  NW(IN)  +  S(l) 

S(2)  =  AINVAL(I)  +  AINVAL(IN)  +  S(2) 

S(5)  =  AINVT(I)  +  AINVT(IN)  +  S(5) 

S(6)  =  AINV(I)  +  AINV(IN)  +  S(6) 

IDEPS  =  IDEPS  +  NW(I)  +  NW(IN) 
lAVS  =  lAVS  +  AINVAL(I)  +  AINVAL(IN) 
lALL  =  lALL  +  AINVT(I)  +  AINVT(IN) 
lUALL  =  lUALL  +  AINV(I)  +  AINV(IN) 

GO  TO  145 
ENDIF 


C 


S(l)  =  S(l)  +  NW(I) 
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S(2)  =  S(2)  +  AINVAL(I) 

S(5)  =  S(5)  +  AINVTCI? 

S(6)  -  3(6)  +  AINV(I) 

IDEPS  =  IDEFS  +  NW(I) 
lAVS  =  lAVS  +  AINVAL(I) 
lALL  =  lALL  +  AINVT(I) 
lUALL  =  lUALL  +  AINV(I) 

C 

145  LX  =  1 

IF(ARATE.EQ.'G'.AND.AORDER.EQ.'l')  LX  =  2 
DO  150  K1  =  l.NOBJ 
J  =  IPRIO(Kl) 

IB  =  INDX(K1,1) 

IE  =  INDX(K1,2) 
lOBJT  =  lOBJT  +  TNUM(J) 

IX  =  I 

DO  155  L  =  1,LX 
DO  155  L5  =  1,5 
TTNAM  =  TOBJ(J) 

IF(TTNAM(l:3).NE.ONAM(L5))  GOTO  155 
IF(L.EQ.2)  IX  =  IN 
IF(IB.EQ.O)  GOTO  155 
DO  160  K  =  IB, IE 
DO  160  K2  =  1,2 

IF(ATNUM(K).EQ.O)  GOTO  160 
IF(AWTYP(K,K2).EQ.IX)  THEN 

NT0T(L5)  =  NT0T(L5)  +  ATNUM(K) 

IF(WPT(K).GT.l)  NT0T(L5)  =  NT0T(L5)  +  ATNUM(K) 
ENDIF 

160  CONTINUE 

155  CONTINUE 

C 

150  CONTINUE 

C 

110  CONTINUE 

C 

C  Change  to  integer  for  printout... 

IIAVS  =  lAVS  +  0.5 
IIWHS  =  IWHS  +  0.5 
IIARS  =  lARS  +  0.5 
HALL  =  lALL  +  0.5 
IISALL  =  ISALL  +0.5 
IIUALL  =  lUALL  +0.5 
IISURV  =  ISURV  +0.5 
DO  175  1175  =  1,6 

175  IS(I175)  =  S(I175)  +  0.5 

C 

DO  170  IL  =  1,5 

NTOT(6)  =  NTOT(6)  +  NTOT(IL) 

.NTOTT(IL)  =  NTOTT(IL)  +  NTOT(IL) 

170  NT0rr(6)  =  NT0TT(6)  +  NTOT(IL) 
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IF(IPLS.EQ.'2')  THEN 

WRITE(LU,3000)  ' | ' ,LNAM(ILEG) , (IS(I6) ,16=1,5) , 

+  (NT0T(IN),IN=1,6),IS(6),'|' 

ELSE 

WRITE (LU, 3030)  ' I' ,LNAM(ILEG) , (IS(I6) ,16=1,4) , 

+  IISURV,IS(5),(NT0T(IN),IN=l,6),ISl6),’r 

ENDIF 

IF(ILEG.LT.3)  WRITE (LU, 3022) 

100  CONTINUE 

* 

WRITE(LU,3020)  '| . ', 

+  ' . ', 

+  ’ . r 

IFdPLS.EQ.  '2')  THEN 

WRITE  (LU,  3002)  'r,'ALL  WEAPONS' ,IDEPS,IIAVS,IIWHS,IIARS, 

+  IIALL,(NT0Tr(IN),IN=l,6),IIUALL, ' | ' 

ELSE 

WRITE (LU, 3032)  'I', 'ALL  WEAPS' ,IDEPS,IIAVS,IIWHS,IIARS, 

+  IISALL, HALL, (NTOTT(IN) , IN=1 ,6) , IIUALL, ' | ' 

ENDIF 

WRITE  ( LU ,  3020 )  '  1V*****>v**iHVVw^**A**********vwh^*vw^vwlr**^  '  ^ 

+  '  iVVhV********Vf**<Hr  ’ 

3000  FORMAT(13X,Al,2X,A5,4X,5(3X,I5),4X,5(I5,lX),3X,I5,3X,I5,3X,Al) 
3002  F0RMAT(13X,A1,2X,A11,1X,I5,4(3X,I5),4X,5(I5,1X),2(3X,I5),3X,A1) 
3020  FORMAT(13X,A41,A49,A16) 

3022  FORMAT(13X,'|',104X,'r) 

3025  FORMAT(///) 

3030  F0RMAT(13X,A1,2X.A5,1X,5(3X,I4),5X,I4,3X,5(I5,1X),2(3X,I5),3X,A1) 
3032  F0RMAT(13X,A1,A9.2X.I4,4(3X,I4),5X,I4,3X,5(I5,1X),3X,I5,3X, 

+  I5,3X,A1) 

■» 

RETURN 

■» 

END 
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SUBROUTINE  ROUT21(LU) 

c 

C  R0UT21  displays  the  goals  achieved  vs  the  desired 
C  objectives  in  summary  format.  LU  is  the  logical 
C  unit  to  which  output  is  sent. 

C 

IMPLICIT  INTEGER*4  (I-N) 

INTEGER*2  LU 
C 

$ INCLUDE:  ’ ALLOC. CDE’ 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PDES.CDE' 

$ INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'PRIO.CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

C 

IF(IPRCRX.EQ.l)  THEN 
CALL  ROUT2A(LU) 

RETURN 

ENDIF 

C 

WRITE (LU, 3035) 

IF(ARATE.EQ.'G')  THEN 

WRITE (LU,*)  'ALLOCATION  SCENARIO:  GENERATED  ALERT  ' 

ELSE 

WRITE(LU,*)  'ALLOCATION  SCENARIO:  DAY-TO-DAY  ALERT  ' 

ENDIF 

IF(CASE.EQ.'D')  THEN 

WRITE(LU,*)  '  DELAYED  LAUNCH  ' 

ELSE 

WRITE (LU.*)  '  PROMPT  LAUNCH  ' 

ENDIF 

WRITE  ( LU ,  3040 )  '  ***>V*5V*******VlnWWr*VWhW><hV*VnV*»ViWr*  '  ^ 

+  '***  DAMAGE  ACHIEVED  BY  TARGET  OBJECTIVE  ********' , 

WRITE(LU,3040)  '  MT  ', 

+  '  . DAY-TO-DAY  ALERT .  ' , 

+  '  . GENERATED  ALERT . ' 

WRITE(LU,3040)  '  TARGET  OU  VNTK  GOAL', 

+  'DE  NOT  DELAYED  LAUNCH  PROMPT  LAUNCH  ', 

+  '  NOT  DELAYED  LAUNCH  PROMPT  LAUNCH  ' 

WRITE(LU,3040)  'PRI  NAME  NUMBER  B  R  (HD)  PASS  1  P' , 

+  'ASS  2  TARGETED  PASS  1  PASS  2  PASS  1  PASS  2  ', 

+  '  TARGETED  PASS  1  PASS  2  PASS  1  PASS  2' 

WRITE(LU,3040)  ' . ', 

+  ' . ' 

^  > 

+  ' - - — ' 

DO  100  K1  =  l.NOBJ 

ICO  =  IPRIO(Kl) 

K  =  ICO 
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201 


110 


ICOP  =  K1 
CALL  ROUT23 
IB  =  INDX(K1,1) 

IE  =  INDX(K1,2) 

DEX  =  0 

IF(IB.NE.O)  THEN 

DO  201  1201  =  IB, IE 

IF(AWTYP(I201,1).EQ.0)  GOTO  201 
IF(AWTYP(I201,2).EQ.0)  THEN 
DEX  =  DEI (1201) 

ELSE 

CALL  SCNDE3(AWTYP(I201,1),ISC,DEX) 

ENDIF 
CONTINUE 
ENDIF 

IF(HDR (K) . EQ . ' * ' . AND . DEX. LT. ODEl (K) )  THEN 
DO  110  1110  =  1,4 

SDE(K, 1110,1)  =  SDE(K,I110,2) 

ENDIF 

IF(ARATE.EQ.'G')  THEN 
IF(ISSPK.EQ.'2')  THEN 

WRITE (LU, 3012)  OPR(K) ,TOBJ(K) ,TNUM(K) ,MOBT(K) ,TUR(K) , 
VNTK1(K),0DE1(K),0DE2(K),N0HIT1(K), 
SDE(K,1,1),SDE(K,1,2),SDE(K,2,1),SDE(K,2,2),N0HIT2(K), 
SDE(K,3,1),SDE(K,3,2),SDE(K,4,1),SDE(K,4,2) 

ELSE 

WRITE (LU, 3010)  OPR(K),TOBJ(K) ,TNUM(K) ,MOBT(K) ,TUR(K) , 
VNTKl(K) ,VNTK2(K) ,VNTK3(K) ,0DE1(K) ,0DE2(K) ,N0HIT1(K) , 
SDE(K,1,1),SDE(K,1,2),SDE(K,2,1),SDE(K,2,2),N0HIT2(K), 
SDE(K,3,1),SDE(K,3,2),SDE(K,4,1),SDE(K,4,2) 

ENDIF 
ELSE 

IF(ISSPK.EQ.'2')  THEN 

WRITE(LU,3017)  OPR(K) ,TOBJ(K) ,TNUM(K) ,MOBT(K) ,TUR(K) , 
VNTKl(K) ,0DE1(K) ,0DE2(K) ,N0HIT1(K) , 
SDE(K,1,1),SDE(K,1,2),SDE(K,2,1),SDE(K,2,2) 

ELSE 

WRITE(LU,3015)  0PR(K),T0BJ(K) ,TNUM(K) ,MOBT(K) ,TUR(K) , 
VNTKl (K) ,VNTK2(K) ,VNTK3(K) ,0DE1(K) ,0DE2(K) ,N0HIT1(K) , 
SDE(K,1.1),SDE(K,1,2),SDE(K,2,1),SDE(K,2,2) 

ENDIF 

ENDIF 

100  CONTINUE 


+ 

+ 

+ 


+ 

+ 

+ 


+ 

+ 


+ 

+ 


WRITE (LU, 3040) 

+  '  Vrtt**iVVrtV?V********Vrt!r****iV*frtWr**V!r^ 

WRITE (LU,*) 


3010  F0RMAT(I3,1X,A12,1X,I6,1X,A1,1X,I1,2X,I2,A1,A1,4X,F4.3,3X, 

+  F4.3,8X,I4,2X.F4.3,3(4X,F4.3),7X,I4,2X,F4.3,3(4X,F4.3)) 
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3012  F0RMAT(I3,1X,A12,1X,I6,1X,A1,3X,I1,2X,I5,1X,F4.3,3X, 

+  F4.3,8X,I4,2X,F4.3,3(4X,F4.3),7X,I4,2X,F4.3,3(4X,F4.3)) 

3015  F0RMAT(I3,1X,A12,1X.I6,1X,A1,3X,I1,2X,I2,A1,A1,1X,F4.3,3X, 

+  F4.3,8X,I4,2X,F4.3,3(4X,F4.3),5(6X,'-')) 

3017  F0RMAT(I3,1X,A12,1X,I6,1X,A1,3X,I1,2X,I5,1X,F4.3,3X, 

+  F4.3,8X.I4,2X,F4.3,3(4X,F4.3),5(6X,'-')) 

3035  FORMAK///) 

3040  FORMAT (A44,A48,A40) 

C 

RETURN 

C 

END 


CJOOOOOCSOCJ  O  OOOC3 
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SUBROUTINE  ROUT22(LU) 


R0UT22  continues  the  allocation  display,  writing  the  summary  tables. 
LU  is  the  logical  unit  to  which  output  is  sent. 

IMPLICIT  INTEGER*4  (I-N) 

CHARACTER*3  STR,STRC(S) 

INTEGER*2  LU 

DIMENSION  DNSUM(5,3),ISUM(5,3),ITOT(3),DO(3), 

+  DSS(5,3,6),DES(A),DZ(3,4),DET(3,6) 

Note:  in  the  DSS(I,J,K)  array,  I  is  for  the  target  category, 

J  is  for  total,  fixed  or  mobile  and  K  is  for  the  four  scenarios 
as  well  as  the  old  DESUM  (K=5)  and  DGSUM  (K=6). 

In  the  DES(I)  array,  I  is  for  the  four  scenarios. 

In  D2(I,J),  i  is  for  total,  fixed  and  mobile  and  J  is  for  the 
scenario.  In  DET(I,J)  I  is  for  total,  fixed  and  mobile, 
and  J  is  for  the  four  scenarios  as  well  as  for  the  old  DEs 
and  DGs.  ITOT(I)  are  totals  FOR  total,  fixed  and  mobile. 

$INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PDES.CDE' 

$INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

DATA  STRC  /'NUC' , 'LDR' , 'OMT' , 'ECN' , 'DEF'/ 

C 

IF(IPRCRX.EQ.l)  THEN 
CALL  R0UT2B(LU) 

RETURN 

ENDIF 

C 

C  Write  out  summaries  of  DEs... 

DO  135  I  =  1,5 

DO  155  1155  =  1,3 
DNSUM(I,I155)  =  0. 

DO  155  J155  =  1,6 
155  DSS(I,I155,J155)  =  0. 

C 

DO  200  I  =  1,N0BJ 
IB  =  INDX(I,1) 

IE  =  INDX(I,2) 

STR  =  TOBJ(I) 

DO  200  J  =  1,5 

IF(STR.EQ.STRC(J))  THEN 
DEADD  =  DENEW(I) 

DEX  =  0 

IF(IB.NE.O)  THEN 
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DO  201  1201  =  IB, IE 

IF(AWTYP(I201,1).EQ.0)  GOTO  201 
IF(AWTYP(I201,2).EQ.0)  THEN 
DEX  =  DEI (1201) 

ELSE 

CALL  SCNDE3 (AWTYP ( I 20 1 , 1) , ISC , DEX) 

ENDIF 

201  CONTINUE 
ENDIF 

IF(DEADD.EQ.O.AND.IB.NE.O)  DEADD  =  DEX 
DO  205  1205  =  1,4 

DES(I205)  =  SDE(I,I205,2) 

205  DSS(J, 1,1205)  =  DSS(J, 1,1205)  +  DES(I205)*TNUM(I) 

DSS(J,1,6)  =  DSS(J,1,6)  +  0DE2(I)*TNUM(I) 

DSS(J,1,5)  =  DSS(J,1,5)  +  DEADD*TNUM(I) 

DNSUM(J,1)  =  DNSUM(J,1)  +  TNUM(I) 

IF(MOBT(I).EQ.'M')  THEN 

DSS(J,3,6)  =  DSS(J,3,6)  +  0DE2(I)*TNUM(I) 

DSS(J,3,5)  =  DSS(J,3,5)  +  DEADD*TNUM ( I ) 

DNSUM(J,3)  =  DNSUM(J,3)  +  TNUM(I) 

DO  305  1305  «  1,4 

305  DSS(J,3,I305)  =  DSS(J,3,I305)  +  DES(I305)*TNUM(I) 

ELSE 

DSS(J,2,6)  a  DSS(J,2,6)  +  0DE2(I)*TNUM(I) 

DSS(J.2,5)  a  DSS(J,2,5)  +  DEADD*TNUM(I) 

DNSUM(J,2)  a  DNSUM(J,2)  +  TNUM(I) 

DO  455  1455  a  1,4 

^55  DSS(J,2,I455)  a  DSS(J,2,I455)  +  DES(I455)*TNUM(I) 

ENDIF 
ENDIF 

200  CONTINUE 
C 

DO  210  I  a  1,5 

DO  202  1202  a  1,3 
D0(I202)  a  0. 

DO  202  J202  a  1,4 

202  DZ(I202,J202)  a  0. 

C 

DO  222  1222  =  1,4 

DO  222  J222  =1,3 

IF(DNSUM(I,J222).NE.O)  DZ(J222 , 1222)  = 

+  DSS(I , J222 , I222)/DNSUM(I , J222) 

222  CONTINUE 

C 

DO  302  1302  a  5,6 

DO  302  J302  a  1,3 

IF(DNSUM(I,J302).NE.0) 

+  D0(J302)  a  DSS(I,J302,I302)/DNSUM(I,J302) 

DSS(I,J302,I302)  =  D0(J302) 

302  CONTINUE 

C 
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DO  223  1223  =  1,3 
DO  223  J223  =1,4 

DSS(I,I223,J223)  =  DZ(I223, J223) 
223  CONTINUE 

210  CONTINUE 
C 

DO  212  1212  =  1,3 
IT0T(I212)  =  0 
DO  212  J212  =  1,6 
212  DET(I212,J212)  =  0 

C 


WRITE (LU, 3005) 

WRITE (LU, 3035)  '  ************  DAMAGE  SUMMARY  BY  TARGET  GROUP', 
+  '  AND  TARGET  MOBILITY  ************* ' 

WRITE (LU, 3035)  '1  ', 


IFCARATE.EQ. 'G')  THEN 
WRITE (LU, 3035)  '| 
h 

ELSE 

WRITE (LU, 3035)  '1 
I- 

ENDIF 

IF(CASE.EQ.'D')  THEN 
WRITE (LU, 3035)  '1 


ALLOCATION  SCENARIO:  GENERATED  ALERT  ', 

I' 

ALLOCATION  SCENARIO:  DAY-TO-DAY  ALERT', 

r 


DELAYED  LAUNCH  ' , 

I  I 


ELSE 

WRITE (LU, 3035)  '| 
f 

ENDIF 

WRITE (LU, 3035)  '| 
f  ' 

WRITE  (LU,  3035)  '|  -  FIXED  TARGETS 


PROMPT  LAUNCH 

I’ 


WRITE (LU, 3035)  '|  NUM  PASS  2 

+  '  I' 

WRITE(LU,3035)  '|  TARGET  OF  AVG  DE  . , 

+  'EVED  DAMAGE  EXPECTANCY .  I' 

WRITE (LU, 3035)  '|  GROUP  TGS  GOAL  DAY  DEL 
+  'DAY  PRL  GEN  DEL  GEN  PRL  j' 

WRITE  (LU,  3035)  '| . . 

+  ’ . r 

DO  220  I  =  1,5 

DO  221  1221  =  1,3 

ISUM(I,I221)  =  DNSUM(I,I221) 

ITOT(I221)  =  IT0T(I221)  +  DNSUM( I , 1221) 

DO  221  J221  =  1,6 
DET(I221,J221)  =  DET(I221, J221)+ 

+  ISUM(I,I221)*DSS(I,I221,J221) 

221  CONTINUE 

IF(ISUM(I,2).NE.O)  THEN 


ACHI' 
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IF(ARATE.EQ. 'D')  THEN 

WRITE (LU, 3020)  ‘ I' ,STRC(I) , ISUM(I ,2) ,DSS(I,2,6) , 

+  DSS(I,2,1),DSS(I,2,2),’ r 

ELSE 

WRITE (LU, 3030)  ' I' ,STRC(I) ,ISUM(I ,2) ,DSS(I ,2,6) , 

+  DSS(I,2,1),DSS(I,2,2),DSS(I,2,3),DSS(I,2,4),' r 

ENDIF 
ENDIF 
220  CONTINUE 

DO  500  1500  =  1,3 
DO  500  J500  =1,6 

IF(ITOT(I500).NE.O)  THEN 

DET(I500,J500)  =  DET(I500, J500)/IT0T(I500) 

ELSE 

DET(I500,J500)  =  0. 

ENDIF 
500  CONTINUE 

WRITE (LU, 3035)  '| . 

+  ; . r 

WRITE (LU, 3035)  '|  ALL  FIXED 

+  •  I* 

IF(ARATE,EQ. 'D')  THEN 

WRITE (LU, 3025)  ' I' , 'TARGETS' ,ITOT(2) ,DET(2,6) ,DET(2,1) , 
+  DET(2,2),'r 

ELSE 

WRITE(LU,3032)  ' | ', 'TARGETS' ,ITOT(2) ,DET(2, 6) ,DET(2,1) , 
+  DET(2,2),DET(2,3),DET(2,4),'|' 


ENDIF 

WRITE(LU,3035) 

4. 

'1 

f 

1 

> 

1  t 

WRITE (LU, 3035) 

4. 

'  I--  MOBILE 

1 

TARGETS  - 

1 

1 

> 

--  1  * 

WRITE (LU, 3035) 

4> 

'1 

1 

NUM 

PASS  2 

1 

> 

i  t 

WRITE (LU, 3035) 

' 1  TARGET 

OF 

AVG  DE 

1 

. ACHI ' , 

+ 

'EVED  DAMAGE 

EXPECTANCY . 

r 

WRITE (LU, 3035) 

' 1  GROUP 

TGS 

GOAL 

DAY  DEL  ' , 

+ 

'DAY  PRL 

GEN  DEL 

GEN  PRL 

1' 

UDITF^TII  ini'll 

'  1 .......... 

t 

4* 

1 

1 

i 

DO  225  I  =  1,5 

■  1 

IF(ISUH(I,3).NE.O)  THEN 
IF(ARATE.EQ. 'D')  THEN 

WRITE (LU, 3020)  ' | ' ,STRC(I) ,ISUM(I ,3) ,DSS(I ,3,6) , 

+  DSS(I,3,1),DSS(I,3,2),' I ' 

ELSE 

WRITE (LU, 3030)  ' 1 ' ,STRC(I ) , ISUM(I , 3) ,DSS(I ,3 ,6) , 

+  DSS(I,3,1),DSS(I,3,2),DSS(I,3,3),DSS(I,3,4),' I ' 

ENDIF 
ENDIF 
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C 


225  CONTINUE 

WRITE (LU, 3035)  '| . . 

+  ; . I’ 

WRITE (LU, 3035)  ’|  ALL  MOBILE 

+  ’  I’ 

IFCARATE.EQ. 'D')  THEN 

WRITE (LU, 3025)  ' T , 'TARGETS' ,ITOT(3) ,DET(3, 6) ,DET(3,1), 
+  DET(3,2),'|' 

ELSE 

WRITE(LU,3032)  ' I' , 'TARGETS' ,IT0T( 3) ,DET(3,6) ,DET(3, 1) , 
+  DET(3,2),DET(3,3),DET(3,4),' 1 ' 

END  IF 


WRITE (LU, 3035) 
+ 

WRITE (LU, 3035) 

+ 

WRITE (LU, 3035) 

+ 

WRITE (LU, 3035) 

+ 

WRITE (LU, 3035) 

+ 

WRITE (LU, 3035) 

+ 


I-  ALL  TARGETS 


I  NUM  PASS  2  ', 

I' 

1  TARGET  OF  AVG  DE  . ACHI ' , 

EVED  DAMAGE  EXPECTANCY .  | ' 

I  GROUP  TGS  GOAL  DAY  DEL  ' , 
DAY  PRL  GEN  DEL  GEN  PRL  1 ' 


DO  230  I  =  1,5 

IF(ISUM(I,l).NE.O)  THEN 
IF(ARATE.EQ. 'D')  THEN 

WRITE(LU,3020)  ' | ' ,STRC(I) , ISUM(I , 1) ,DSS(I , 1 ,6) , 
+  DSS(I,1,1),DSS(I,1,2),' r 

ELSE 

WRITE(LU,3030)  ' | ' ,STRC(I) ,ISUM(I , 1) ,DSS(I , 1 ,6) , 
+  DSS(I,1,1),DSS(I,1,2),DSS(I,1,3),DSS(I,1,4),'|' 

ENDIF 


ENDIF 
230  CONTINUE 

WRITE (LU, 3035)  '| . 

+  ’ . r 

WRITE (LU, 3035)  '|  ALL 

+  ’  I' 

IF(ARATE.EQ. 'D')  THEN 

WRITE (LU, 3025)  ' | ', 'TARGETS' , ITOT(l) ,DET(1, 6) ,DET(1 , 1) , 
+  DET(l,2),'l' 

ELSE 

WR ITE ( LU , 3  0 3 2 )  ' | ' TARGETS ' , ITOT ( 1 ) , DET ( 1 , 6 ) , DET ( 1 , 1 ) , 
+  DET(1,2),DET(1,3),DET(1,4),' r 

ENDIF 


^  *V Vf *V#V A «V ♦V'iWf  «V«V ^ «Wf*V »V •'»  *V ^ 


c 
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3005  FORMAK///) 

3020  F0RMAT(28X,A1,3X,A3,4X,I5,6X,F4.3,2(7X,F4.3),2(9X,'--'), 

+  6X,A1) 

3025  FORMAT(28X,Al,2X,A7,lX,I5,6X,F4.3,2(7X,F4.3),2(9X,'— '), 

+  6X,A1) 

3030  F0RMAT(28X,A1.3X,A3,4X,I5,6X,F4.3,2(7X,F4.3),1X,2(7X,F4.3), 
+  5X,A1) 

3032  F0RMAT(28X,A1,2X,A7,1X,I5,6X,F4.3,2(7X,F4.3),1X,2(7X,F4.3), 
+  5X,A1) 

3035  FORMAT (28X,A43,A34) 

C 

RETURN 

C 

END 
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SUBROUTINE  ROUT23 

C 

C  R0UT23  displays  the  goals  achieved  vs  the  desired 
C  objectives  for  all  scenarios. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PDES.CDE' 

$ INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

CHARACTER*10  NAME,NAME2 
DIMENSION  SDEL(4,2) 

C 

K  =  ICO 
C 

C  Do  the  initializations... 

DO  105  I  =  1,4 
DO  105  J  =  1,2 
SDE(K,I,J)  =  0 
105  CONTINUE 

NOHITl(K)  =  TGOFOR(K) 

C 

C  Get  the  Passl  values... 

IB  =  INDXdCOP,!) 

IE  =  INDXdCOP, 2) 

IFdB.EQ.O)  GOTO  255 
DO  250  L2  =  IB, IE 

IF(ATNUM(L2).EQ.O)  GO  TO  250 
IF(AWTYP(L2,l).EQ.O)  GOTO  250 
IW  =  AWTYP(L2,1) 

NAME  =  -WNAMCIW) 

DO  305  1305  =  1,4 

IF(AWTYP(L2,2).EQ.O)  THEN 
SDELd305,l)  =  DEA(L2,I305) 

ELSE 

CALL  SCNDE3 ( AWTYP ( L2 . 1 ) , I 305 , SDEL (I 305 , 1 ) ) 

ENDIF 
305  CONTINUE 

C  Recalculate  the  Puss  i  total  DE... 

C  Skip  for  now  if  this  is  the  first  weapon  of  a  Passl,  different 

C  weapon  pair. . . 

IF(WPT(L2).EQ.-1)  GOTO  250 

C  For  all  combinations  of  singles,  pairs,  do  the  calculations  for 

C  the  generated  cases... 

SDE(K,3,1)  =  SDE(K,3,1)  +  SDEL(3 . 1)*ATNUM(L2) 

SDE(K,4,1)  =  SDE(K,4,1)  +  SDEL(4 , 1)*ATNUM(L2) 

For  single  weapons  or  pairs  of  the  same  weapon,  check  for  'g' 


C 


u  u 
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C  weapons  before  calculating  the  day  cases... 

IF(WPT(L2).GE.1.AND.NAME(1:1).EQ. ‘g')  THEN 
NOHITl(K)  =  NOHITKK)  +  ATNUM(L2) 

GOTO  250 

ENDIF 

C  If  this  is  the  second  weapon  of  a  diff-weapon  pair... 

IF(WPT(L2).EQ.-2)  THEN 

NAME2  =  WNAM(AWTYP(L2"1,1)) 

C  Add  to  NOHITl  and  do  not  do  day  calcs  if  both  weapons  of 

C  the  pair  are  generated. . . 

IF(NAME2(1:1).EQ. 'g' .AND.NAME(1: 1) .EQ. 'g')  THEN 
NOHITKK)  =  NOHITl  (K)  +  ATNUM(L2) 

GOTO  250 
ENDIF 

C  If  the  second  weapon  is  day  and  the  first  of  the  pair  is 

C  generated,  get  the  appropriate  SDEL. . . 

IF(NAME2(1: 1) .EQ. ’g' .AND.NAME(1 : 1) .EQ. 'd' )  THEN 
CALL  SCNDE3  (AWTYP  (1.2 , 1 ) ,  1 ,  SDEL(  1 , 1 ) ) 

CALL  SCNDE3 (AWTYP (L2 , 1 ) , 2 , SDEL(2 , 1 ) ) 

ENDIF 

C  If  the  second  weapon  is  generated  and  the  first  of  the  pair 

C  is  day,  get  the  appropriate  SDEL... 

IF(NAME2(1:1).EQ. 'd' .AND.NAME(1: 1) .EQ. 'g')  THEN 
CALL  SCNDE3 ( AWTYP(L2- 1 , 1 ) , 1 , SDEL( 1 , 1 ) ) 

CALL  SCNDE3(AWTYP(L2-1,1),2,SDEL(2,1)) 

ENDIF 

ENDIF 

C  Both  weapons  are  day,  or  the  appropriate  SDEL  values  have  been  set... 

SDE(K,1,1)  =  SDE(K,1,1)  +  SDEL(1,1)*ATNUM(L2) 

SDE(K,2,1)  =  SDE(K,2.1)  +  SDEL(2, 1)*ATNUM(L2) 

250  CONTINUE 

Do  initializations  for  Pass  2... 

255  DO  502  1502  =  1,4 
502  SDE(K,I502,2)  =  SDE(K . 1502 , 1) 

C 

C  Get  the  Pass  2  contributions  to  total  DE... 

IF(IB.EQ.O)  GOTO  355 
DO  500  L2  =  IB, IE 

IF(ATNUM(L2).EQ.0)  GO  TO  500 
IF(AWTYP(L2,2).EQ.O)  GOTO  500 
IW  =  AWTYP (L2, 2) 

NAME  =  WNAM(IW) 

DO  505  1505  =  1,4 

IF(AWTYP(L2,1) .EQ.O)  THEN 

SDEL(I505,2)  =  DEA(L2,I505) 

ELSE 

C  Calculate  the  incremental  DE... 

CALL  SCNDE3 (AWTYP(L2 , 1) , 1505 ,DEX) 

SDEL(I505,2)  =  DEA(L2,I505)  -  DEX 
ENDIF 


oooo  on  on  on  o  on  ooooo 
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505  CONTINUE 

Recalculate  the  Pass  2  total  DE... 

Skip  for  now  if  this  is  the  first  weapon  of  a  Pass2,  different 
weapon  pair. . . 

IF(WPT(L2).EQ.-1)  GOTO  500 

For  all  combinations  of  singles,  pairs,  do  the  calculations  for 
the  generated  cases... 

SDE(K,3,2)  =  SDE(K,3,2)  +  SDEL(3,2)*ATNUM(L2) 

SDE(K,4,2)  =  SDE(K,4,2)  +  SDEL(4,2)*ATNUM(L2) 

For  single  Pass  2  weapons  or  pairs  of  the  same  weapon,  check 
for  'g'  weapons  before  calculating  the  day  cases... 
IF(AWTyP(L2,l).EQ.O)  THEN 

IF(WPT(L2).GE.1.AND.NAME(1;1).EQ. 'g')  THEN 
NOHITl(K)  =  NOHITl(K)  +  ATNUM(L2) 

GOTO  500 

ENDIF 

If  this  is  the  second  weapon  of  a  diff-weapon  pair... 
IF(WPT(L2).EQ.-2)  THEN 

NAME2  =  WNAM(AWTYP(L2-1,2)) 

Add  to  NOHITI  and  do  not  do  day  calcs  if  both  weapons  of 
the  pair  are  generated... 

IF(NAME2(1:1).EQ. 'g' .AND.NAME(1 : 1) .EQ. 'g')  THEN 
NOHITI (K)  =  NOHITl(K)  +  ATNUM(L2) 

GOTO  500 
ENDIF 

If  the  second  weapon  is  day  and  the  first  of  the  pair  is 
generated,  get  the  appropriate  SDEL. . . 

IF(NAME2(1 : 1) .EQ. 'g' .AND.NAME(1 : 1) .EQ. 'd' )  THEN 
CALL  SCNDE3 (AWTYP(L2 , 2) , 1 , SDEL( 1,2)) 

CALL  SCNDE3 ( AWTYP (L2 , 2 ) , 2 , SDEL (2,2)) 

ENDIF 

If  the  second  weapon  is  generated  and  the  first  of  the  pair 
is  day,  get  the  appropriate  SDEL... 

IF(NAME2(1:1).EQ. 'd' .AND.NAME(1: 1) .EQ. 'g')  THEN 
CALL  SCNDE 3 (AWTYP ( L2 - 1 , 2 ) , 1 , SDEL ( 1 , 2 ) ) 

CALL  SCNDE3 (AWTYP (L2 - 1 , 2 ) , 2 , SDEL ( 2 , 2 ) ) 

ENDIF 

ENDIF 

ENDIF 

For  a  cross-pass  pair,  add  the  full  single-weapon  value  if  this 
is  a  day  weapon  and  the  pass  1  weapon  was  generated.  If  both  are 
day  weapons,  add  the  incremental  value  for  this  weapon  (already 
set).  If  this  is  a  gen  weapon,  add  nothing... 
IF(AWTYP(L2,l).NE.0.AND.WPT(L2).EQ.l)  THEN 
IF(NAME(1:1).EQ. 'g')  GOTO  500 
NAME 2  =  WNAM(AWTYP(L2,1)) 

IF(NAME2(1:1).EQ. 'g' .AND.NAME(1 : 1) .EQ. 'd')  THEN 
CALL  SCNDE3 (AWTYP ( L2 , 2 ) , 1 , SDEL ( 1 , 2 ) ) 

CALL  SCNDE 3 ( AWTYP ( L2 , 2 ) , 2 , SDEL ( 2 , 2 ) ) 

ENDIF 

ENDIF 
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C  Both  weapons  are  day,  or  the  appropriate  SDEL  values  have  been  set. 

SDE(K,1,2)  =  SDE(K,1,2)  +  SDEL(1 ,2)*ATNUM(L2) 

SDE(K,2,2)  =  SDE(K,2,2)  +  SDEL(2,2)*ATNUM(L2) 

500  CONTINUE 
C 

C  Summarize... 

355  DO  115  I  =  1,4 
DO  115  J  =  1,2 

SDE(K,I,J)  =  SDE(K,I,J)/TNUM(K) 

115  CONTINUE 

N0HIT2(K)  =  TGOFOR(K) 

C 

RETURN 

C 

END 


o  o  o  o  o 
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SUBROUTINE  ROUT30(LU,I50) 


ROUT30  displays  the  time-ordered  allocation  table  headers, 

LU  is  the  logical  unit  to  which  output  is  sent.  150  is  an 
index  for  the  scenario  to  be  printed. 

IMPLICIT  INTEGER*A  (I-N) 

INTEGER*2  LU 
C 

$  INCLUDE:  ' RULES. CDE' 

C 

WRITE (LU. 3000) 

C 

IF(I50.EQ.l) 

+  WRITE(LU,304S)  '-.wrivvrVfVfVrVnVivvrAtVjvVMV******^^^  DAMAGE  BY  WEAPON  T' , 
+  'IMING  **  DAY-TO-DAY  ALERT,  DELAYED  LAUNCH  SCENARIO  *', 

+  '  **iVVr)V**VrVtVf*VfiV*VrVf  >V*V!r*Vf ' 

IF(I50.EQ.2) 

+  WRITE  (LU,  3045)  '  ******A*****A**Vnv****Vf**  DAMAGE  BY  WEAPON  ' , 
+  'TIMING  **  day-to-day  ALERT,  PROMPT  LAUNCH  SCENARIO 

+  ’  ?V*jV***iV****iVAVfVr*Vf*****iV ' 

IF(I50.EQ.3) 

+  WRITE  (LU,  3045)  '  *Vf  av?  ********************  DAMAGE  BY  WEAPON  ', 
+  'TIMING  **  generated  ALERT,  DELAYED  LAUNCH  SCENARIO 

+  '  Vf***i'f*Vf**AA**Vf  A**A**Vf*** ' 

IF(I50.EQ.4) 

+  WRITE(LU,3045)  '********;>***********»•?***  DAMAGE  BY  WEAPON  ', 
+  'TIMING  **  GENERATED  ALERT,  PROMPT  LAUNCH  SCENARIO 

+  '  AAAAAAAAAAAAVrAAAVf****** ' 

WRITE(LU,3045)  '| 

+:  I,  I  I 

+  ■  I  I* 

WRITE (LU, 3045)  '| 

+  '  Number  |  TU  WEAPONS  |  TS  WEAPONS  |NTS', 

+  '  WEAPONS  I  TOTAL  i’ 

WRITE (LU. 3045)  '|  M  GOAL  DE  ', 

+  '  Hit  w/o  I . 1 . 1---', 

+  ’ . I . r 

WRITE  (LU,  3045)  '|  TARGET  0  VNTK  . ', 

+  '-  Not  1  Approp  I  Nura  Cum  |  Num  Cum  1  Nu' , 

+  'm  Cum  I  Num  |  ' 

WRITE (LU, 3045)  '|PRI  NAME  Num  B  (HD)  Passl  Pass', 

+  '2  Targeted  Time  Weap  |  Weaps  DE  !  Weaps  DE  !  We', 

+  ' aps  DE  1  Weaps  DE  j ' 

WRITE (LU, 3045)  '| . 

+  ' . . . ' 


C 

3000  F0RNAT(///) 

3040  F0RMAT(A38,A54,A40) 
3045  F0RMAT(8X,A42,A52,A23) 
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C 

C 


RETURN 

END 
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SUBROUTINE  ROUT40(LU,  150) 

c 

C  R0UT40  displays  the  time-ordered  allocation  table  headers 
C  (by  weapon  timing  and  target  category  &  timing).  LU  is  the 
C  logical  unit  to  which  output  is  sent.  ISO  is  an  index  for 
C  the  scenario  to  be  printed. 

C 

IMPLICIT  INTEGER*4  (I-N) 

INTEGER*2  LU 
C 

$ INCLUDE:  ' RULES. CDE’ 

C 

WRITE (LU, 3000) 

IFdSO.EQ.l)  WRITE  (LU,  3045) 

+  '**********Vf*****,v  damage  summary  by  WEAP', 

+  'ON  TIMING  **  DAY-TO-DAY  ALERT,  DELAYED  LAUNCH  SCENAR', 
+  '10 

IF(IS0.EQ.2)  WRITE (LU, 3045) 

+  '  •.VVfVfAVfiV  AAAVfVf  AVnVAAAA  DAMAGE  SUMMARY  BY  WEA' , 

+  'PON  TIMING  **  DAY-TO-DAY  ALERT,  PROMPT  LAUNCH  SCENAR', 
+  ' 10  ****************** ' 

IF(I50.EQ.3)  WRITE(LU,3045) 

+  '  *****Vr*********Vf**  DAMAGE  SUMMARY  BY  WEA' , 

+  'PON  TIMING  **  GENERATED  ALERT,  DELAYED  LAUNCH  SCENAR', 

+  '10  *******Vf ********** ' 

IF(I50.EQ.4)  WRITE(LU,3045) 

+  '  *Vf**Vf**Vf**********  DAMAGE  SUMMARY  BY  WEA* , 

+  'PON  TIMING  **  GENERATED  ALERT,  PROMPT  LAUNCH  SCENARI', 
+  ' 0  ******************* ' 

WRITE (LU, 3045)  '| 


WRITE (LU, 3045)  '|  '. 

+  '  Number  |  TU  WEAPONS  |  TS  WEAPONS  |NTS  WEA', 

+  'PONS  I  TOTAL  r 

WRITE (LU, 3045)  '|  GOAL  DE 

+  '  Hit  w/o  I . I . I . ' , 

+ ' . I . r 

WRITE  (LU,  3045)  '|  TARGET  ', 

+  'not  1  Approp  I  Num  Cum  |  Num  Cum  |  Num  ', 

+  'Cum  1  Num  Cum  | ' 

WRITE (LU, 3045)  '|  TYPE  Num  Passl  Pass2  TA' , 

+  'RGETED  Time  Weap  |  Weaps  DE  |  Weaps  DE  |  Weaps  ', 

+  '  DE  I  Weaps  DE  | ' 

WRITE (LU, 3045)  '| . ', 


C 

3000  FORMAT  (///) 

3045  FORMAT(10X,A40,A52,A21) 
C 
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C 


RETURN 

END 


on  no  on</>  non 


SUBROUTINE  RPOUT 
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RPOUT  handles  the  printout  of  all  results. 


IMPLICIT  INTEGER*4 
INTEGER*2  LU 
INCLUDE:  ' PRINT. CDE' 


(I-N) 


Show  the  damage  achieved... 

LU  =  16 

CALL  RPOUTl(LU) 

Display  allocations  (weapons  used  against  targets).. 
CALL  RP0UT2(LU) 

Display  time-ordered  allocations  ... 

CALL  RP0UT3(LU) 

CALL  RP0UT4(LU) 

C 

RETURN 

C 

END 
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SUBROUTINE  RPOUTI(LU) 

C 

C  RPOUTl  displays  the  goals  achieved  vs  the  desired 
C  objectives.  LU  is  the  logical  unit  to  which  output 
C  is  sent.  IPL  is  the  number  of  lines  printed 
C  for  each  objective. . .this  is  used  to  print  out  the 
C  weapons  of  choice  in  stacked  format. .. (Note:  with  the 
C  improved  selections  of  WOC,  the  comparison  of  WOC  in  the 
C  allocation  against  selected  WOC  --leg,  type,  etc  --  is  not 
C  done . . . ) 

C 

IMPLICIT  INTEGER*4  (I-N) 

INTEGER*2  LU 
C 

$  INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'PRINT. CDE' 

$  INCLUDE:  'PRIO.CDE' 

$  INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'SSPKDE.CDE' 

$  INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

CHARACTER* 12  WRWOC 
CHARACTER*^  REQS1,REQS2 
C 


WRITE (LU, 3035) 

WRITE(LU,3040)  '  *Vf***Vf****Vti'nV?V'iV*Vf*Vr*Vfi'f****iV**iVVf***iV*iViV*iViV*** ' 
+  '  ALLOCATION  OF  WEAPONS  BY  TARGET  OBJECTIVE  ***^V*>V*>V**^V  *  j 


^  ^  V*  V*  V*  «Wf  *  VVi  V*  Vf  V»  *  V  *  V  V»  *  V  ^ V  Vf  *Vf*********»V* ' 


WRITE(LU,3040)  ' 


+  '  ALLOCATION 

+  '  ’ 


> 


WR1TE(LU,3040)  ' 


WRITE(LU,3040) 
+  '  PASS  1 
+  ' 

WRITE (LU, 3040) 
+  ' 

+  '  GOAL 


MT  WEAPON (S)  ', 

PASS  2  ', 

UNMET  REQ  M  ' 

0  U  VNTK  OF  '  , 

GOAL  '  , 

PASS  PASS  D  ’ 


WRITE(LU,3040)  'PRI  TARGET  NUM  B  R  (HD)  CHOICE 

+  '  NUM  WPT  WEAPON  DE  IDE  MDE  NUM  WPTWEAPO', 
+  'N  DE  IDE  MDE  1  2  G  ' 


WRITE(LU,3040) 


C 


IMDR  =  0 
DO  no  I=1,N0BJ 


-  236  - 


IPL  =  1 
WRWOC  =  ' 

IWTYP  =  0 
K  =  IPRIO(I) 

ICO  =  K 
ICOP  =  I 

IF(MDR(K).EQ. '*')  THEN 

IMDR  =  1 
ENDIF 

IFdSSPK.EQ.  '2'  .OR.ISSPK.EQ.  '4')  THEN 

WRITE(LU,3015)  OPR(K) ,TOBJ(K) ,TNUM(K) ,MOBT(K) ,TUR(K) , 

+  vntki(K).woc(k,i).tgofor(K),'not  targeted', 

+  ODEl(K),ODE2(K),MDR(K) 

ELSE 

WRITE(LU,3010)  OPR(K) ,TOBJ(K) ,TNUM(K) ,MOBT(K) ,TUR(K) , 

+  VNTKl(K) ,VNTK2(K) ,VNTK3(K) ,WOC(K, 1) ,TGOFOR(K) , 

+  'NOT  TARGETED' ,ODEl(K),ODE2(K),MDR(K) 

ENDIF 

C 

IF(MOBT(K).EQ. 'M')  THEN 
NDET  =  0. 

IF(PDET(K).NE.1.0)  NDET  =  INT(TNUM(K)*(1. -PDET(K))+.5) 
WRITE(LU,3050)  NDET ,' UNDETECTED ' 

ENDIF 

C 

IB  =  INDXCICOP.l) 

IE  =  INDX(IC0P,2) 

IF(IB.EQ.O)  GOTO  255 
DO  500  12  =  IB, IE 

C  Ignore,  if  there  are  no  weapons... 

IF(ATNUM(I2).EQ.O)  GOTO  500 
C  Initialize... 

IPL  =  IPL  +  1 
WRWOC  =  ' 

IF(IPL.EQ.2)  WRWOC  =  ANDOR(K) 

IF(IPL.EQ.3)  WRWOC  =  WOC(K,2) 

C  Check  for  Pass2  weapons  only. . . 

IF(AWTyP(I2,2).NE.O)  THEN 
REQS2  =  '  ' 

IF(MOBT(K).EQ. 'M' .AND.M0BW(AWTyP(I2,2)) .NE. 'M') 

+  REQS2(1:1)  =  'M' 

IF(WTU(AWTYP(I2,2)).GT.TUR(K))  REQS2(2:2)  =  'T' 
IF(DEA(I2,ISC).LT.ODE2(K).AND.WPT(I2).NE.-l) 

+  REQS2(3:3)  =  'D' 

C  Write  out  appropriately... 

IF(AWTYP(I2,l).EQ.O)  THEN 
IWPT  =  WPT(I2) 

IF(IWPT.EQ.-2)  IWPT  =  1 
IF(WPT(I2).EQ.-1)  THEN 

C  Calculate  the  total  DE  in  Pass  1... 

DE20  =  0. 
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DO  20  120  =  IB, IE 

IF(I20.GT.I2.AND.AWTYP(I20,1).NE.AWTYP(I2,1)) 

+  GOTO  27 

IF(AWTYP(I55,1).EQ.O.OR.WPT(I55).EQ.-1)  GOTO  20 
DTEMP  =  DE(K,AWTYP(I2,1)) 

IF(WPT(I20).EQ.-2)  DTEMP  =  DEA(I20,ISC) 

DE20  =  DE20  +  DTEMP*ATNUM(I20) 

20  CONTINUE 

C  Calculate  the  total  DE  to  this  point  in  Pass  2... 

27  DE25  =  DE20 

DO  25  125  =  IB, 12 

IF(AWTYP(I25,2).EQ.0.0R.WPT(I25).EQ.-2)  GOTO  25 
DTEMP  =  DE(K,AWTYP(I2,2)) 

IF(AWTYP(I25,l).NE.O) 

+  DTEMP  =  DTEMP  -  DE(K,AWTYP(I25,1)) 

DE25  =  DE25  +  DTEMP*ATNUM(I25) 

25  CONTINUE 

DEIX  =  DE25/TNUM(K) 

WRITE (LU , 3030 )  WRWOC , ATNUM (12),'-', 

+  WNAM(AWTYP(I2,2)),DE(K,AWTYP(I2,2)),DEIX,REQS2 

ELSE 

WRITE(LU,3120)  WRWOC , ATNUM (12) , IWPT, 

+  WNAM(AWTyP(I2,2)),DEA(I2,ISC),DEI(I2),REQS2 

ENDIF 
ENDIF 
ENDIF 
C 

C  Now,  account  for  those  hit  in  the  first  Pass... 
IF(AWTYP(I2,l).NE.O)  THEN 
REQSl  =  '  ' 

IF(MOBT(K).EQ. 'm' .AND.M0BW(AWTYP(I2, 1)) .NE. 'M') 

+  REQS1(1:1)  =  'M' 

IF(WTU(AWTYP(I2,1)).GT.TUR(K))  REQS1(2:2)  =  'T' 
IF(DEA(I2,ISC).LT.0DE1(K).AND.WPT(I2).NE.-1) 

+  REQS1(3:3)  =  'D' 

C  Write  out  appropriately... 

IF(AWTYP(I2,2).EQ.O)  THEN 
IWPT  =  WPT(I2) 

IF(IWPT.EQ.-2)  IWPT  =  1 
IF(WPT(I2).EQ.-1)  THEN 

C  Calculate  the  total  Pass  1  DE... 

DE35  =  0. 

DO  35  135  =  IB, 12 

IF(I35.NE.I2.AND. (AWTYP(I35 , 1) .EQ.O .OR. 

+  WPT(I35).EQ.-1))  GOTO  35 

DTEMP  =  DE(K,AWTYP(I2,1)) 

IF(WPT(I35).EQ.-2)  DTEMP  =  DEA(I35,ISC) 

DE35  =  DE35  +  DTEMP*ATNUM(I35) 

35  CONTINUE 

DEIX  =  DE35/TNUM(K) 

WRITE (LU , 3025 )  WRWOC , ATNUM (12),'-', 


o  o  o 
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+  WNAM(AWTYP(I2,1)),DE(K,AWTYP(I2,1)),DEIX,REQS1 

ELSE 

C  Don't  write  out  is  this  line  has  been  merged  with 

C  another  part  of  this  subset,  hit  by  a  second  weapon... 

IF(I2.GT.IB.AND.AWTYP(I2,1).EQ. 

+  AWTYP(I2-1,1))  THEN 

IPL  =  IPL  -  1 
ELSE 

WRITE (LU , 3020 )  WRWOC , ATNUM ( I 2 ) , I WPT , 

+  WNAM(AWTYP(I2,1)),DEA(I2,ISC),DEI(I2),REQS1 

ENDIF 
ENDIF 
ENDIF 
ENDIF 

This  is  a  cross-pass  pair .. .Combine  subsets  where  some 
got  a  second  weapon,  others  did  not... 
IF(AWTYP(I2,1).NE.O.AND.AWTYP(I2,2).NE.O)  THEN 

IF(I2.GT.IB.AND.AWTYP(I2,1).EQ.AWTYP(I2-1,1))  THEN 
WRITE(LU,3120)  WRWOC , ATNUM ( I 2 ) ,WPT(I2) , 

+  WNAM(AWTYP(I2,2)),DEA(I2,ISC),DEI(I2),REQS2 

ELSE 

C  Sum  the  totals  of  the  Pass  1  weapon... 

NUMTOT  =  ATNUM(I2) 

DO  45  145  =  12+1, IE 

IF(AWTYP(I45,1).NE.AWTYP(I2,1))  GOTO  50 
NUMTOT  =  NUMTOT  +  ATNUM (145) 

45  CONTINUE 

C  Here,  recalculate  the  total  DE  for  the  first  pass... 

50  DE55  =  0. 

DO  55  155  =  IB, IE 

IF(I55.GT.I2.AND.AWTYP(I55,1).NE.AWTYP(I2,1)) 

+  GOTO  60 

IF(AWTYP(I55,1).EQ.0.0R.WPT(I55).EQ.-1)  GOTO  55 
DTEMP  =  DE(K,AWTYP(I55,1)) 

IF(WPT(I55).EQ.-2)  DTEMP  =  DEA(I55,ISC) 

DE55  =  DE55  +  DTEMP*ATNUM(I55) 

55  CONTINUE 

60  DEIX  =  DE55/TNUM(K) 

WRITE ( LU , 3220 )  WRWOC , NUMTOT , WPT ( I 2 ) , 

+  WNAM(AWTYP(I2, D), DECK, AWTYP(I2,1)), DEIX, 

+  ATNUM ( I 2 ) , WPT ( I 2 ) , WNAM ( AWTYP (12,2)), 

+  DEA(I2,ISC),DEI(I2),REQS1,REQS2 

ENDIF 
ENDIF 
500  CONTINUE 
C 

255  CONTINUE 

IPL  =  IPL  +  1 
IF(IPL.EQ.2)  THEN 

WRWOC  =  ANDOR(K) 
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C 


C 


IFCWRWOC.NE. '  ') 

WRITE (LU, 3045)  WRWOC 
WRITE (LU, 3045)  W0C(K,2) 
ENDIF 

ENDIF 

IF(IPL.EQ.3)  THEN 

WRWOC  =  ANDOR(K) 
IFCWRWOC.NE.'  ') 

WRITE (LU, 3045)  WOC(K,2) 
ENDIF 


THEN 


THEN 


ENDIF 


WRITE (LU, 3040)  ' 


no  CONTINUE 
C 

3010  F0RMAT(I3,1X,A12,1X,I5,1X,A1,1X,I1,1X,I2,A1,A1,2X,A12, 

+  1X,I5,1X,A12,2X,F4.3,33X,F4.3,22X,A1) 

3015  F0RMAT(I3,1X,A12,1X,I5,1X,A1,1X,I1,1X,I5,1X,A12, 

+  1X,I5,1X,A12,2X,F4.3,33X,F4.3,22X,A1) 

3020  F0RMAT(33X,A12,1X,I5,2X,I1,2X,A10,4X,2(1X.F4.3),39X,A4) 

3025  F0RMAT(33X,A12,1X,I5,2X,A1,2X,A10,4X,2(1X,F4.3),39X,A4) 

3030  F0RMAT(33X,A12,37X,I5,2X,A1,2X,A10,5X,2(1X,F4.3),7X,A4) 

3035  FORMATC///) 

3040  FORMAT(A44,AS4,A33) 

3045  FORMAT(33X,A12) 

3050  F0RMAT(46X,I5,1X,A10) 

3120  F0RMAT(33X,A12,37X,I5,2X,I1,2X,A10,5X,2(1X,F4.3),7X,A4) 

3220  F0RMAT(33X,A12,1X,I5,2X,I1,2X,A10,4X,2(1X,F4.3),2X,I5,2X, 

+  I1,2X,A10,5X,2(1X,F4.3).2X,A4,1X,A4) 

C 

WRITE  (LU ,  3040)  '  ****iv*****A*************v'f***?v*****i'nv******A* ' 

+  '  ***•.’?***************************** AVr*A**AAA**AAV<  *A  ' 

^  > 

+  '  •.V***A!V‘.V**AA*AVf.r*A*AA*A**A*A***ftfrV!r  ’ 


c 


WRITE(LU,3035) 

RETURN 


> 


C 


END 
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SUBROUTINE  RPOUT2(LU) 

C 

C  RP0UT2  displays  the  allocation  of  weapons  used  against  targets. 

C  LU  is  the  logical  unit  to  which  output  is  sent. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

CHARACTER* 10  NAMEl 
CHARACTER*8  NAME2 
CHARACTER*!  LC0MP(3) 

INTEGER*2  LU 
INTEGER*4  S1,S2,S3,S4 
C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'PRIO.CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  NT0T(2) 

DATA  LCOMP  / ' I ' , 'S ' . 'A'/ 

C 

IDEPS  =  0 
lAVS  =  0 
IWHS  =  0 
lARS  =  0 
ISALL  =  0 
lALL  =  0 
lUALL  =  0 
lAALL  =  0 
IDALL  =  0 
I GALL  =  0 
C 

WRITE (LU, 3020)  '  *Vf***Vt*yf*'>V!V****VnV**A*-.V*iVVfVf.V**sVVfyf**  ALLOCA' , 

+  'TION  OF  WEAPONS  BY  WEAPON  TYPE  ******************', 

+  '  ****;V***Vf*;V*A**>V ' 

IFdPLS.EQ. '2')  THEN 

WRITE(LU.3020)  '|  L  M  U 

+  ' . LOSSES .  ', 

+  '  I' 

WRITE(LU,3020)  '|  E  0  R  DE-  N', 

+  'OT  WITH-  NOT  ALLOCAT . ALLOCATED-', 

+  ' .  UNAL-  r 

WRITE (LU, 3020)  '|  WEAPON  TYPE  G  PRI  B  G  PLOYED  AV' , 

+  'AIL  HELD  ALERT  ABLE  Target  Weapo', 

+  'ns  LOCATED  |' 

ELSE 

WRITE (LU, 3020)  '|  L  M  U  ---', 

+  ' . LOSSES . 
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WRITE (LU, 3020)  '|  E  0  R  DE-  NO', 

+  'T  WITH-  NOT  NOT  ALLOCAT . ALLOCATED-', 

+  ' .  UNAL-  r 

WRITE (LU, 3020)  '|  WEAPON  TYPE  G  PRI  B  G  PLOYED  AVA', 
+  ' IL  HELD  ALERT  SURV  ABLE  Target  Weapo', 

+  'ns  LOCATED  |' 

ENDIF 

C 

DO  100  ILEG  =1,3 
DO  100  1100  =  1,WPMAX 
DO  100  I=1,NWTYP 

IF(WPR(I).NE.I100.0R.WLEG(I).NE.LC0MP(ILEG))  GOTO  100 
IF ( ARATE . EQ . ' G ' . AND . AORDER . EQ . ' 1 ' . 

+  AND.I.GT.NWTYP/2)  GOTO  100 
IN  =  I  +  NWTYP/2 
lOBJT  =  0 
C 

NAMEl  =  WNAM(I) 

IWHS  =  IWHS  +  AINVWL(I)  +0.5 
lARS  =  lARS  +  AINVRL(I)  +0.5 
IFdPLS.EQ. '1')  ISALL  =  ISALL  +  AINVNS(I) 

C 

WRITE(LU,3020)  '| . ', 

j.  ' _  I 


IF(ARATE.EQ. 'G' .AND. AORDER. EQ. ' 1 ' )  THEN 

51  =  NW(I)  +  NW(IN) 

52  =  AINVAL(I)  +  AINVAL(IN)  +0.5 

53  =  AINVT(I)  +  AINVT(IN)  +  0.5 

54  =  AINV(I)  +  AINV(IN) 

IDEPS  =  IDEPS  +  SI 
lAVS  =  lAVS  +  S2 

lALL  =  lALL  +  S3 
lUALL  =  lUALL  +  S4 
NAME2(1:8)  =  NAME1(3:10) 

C  Convert  to  integer... 

IINVWL  =  AINVWL(I)  +  0.5 
IINVRL  =  AINVRL(I)  +0.5 
IINVNS  =  AINVNS(I)  +  0.5 
IFdPLS.EQ. '2')  THEN 

WRITE(LU,3000)  '|  '  ,NAME2,WCATd)  .WLEGCI)  ,WPRd)  , 

+  MOBWd),WTUd), SI, S2, IINVWL, IINVRL, S3, S4,  '  |  ' 

ELSE 

WRITE(LU,3030)  'I'  ,NAME2.WCATd) , WLEGCI)  ,WPRd)  , 

+  MOBWd), WTUd), SI, S2, IINVWL, IINVRL, IINVNS, S3, S4,'  1  ' 

ENDIF 
GO  TO  145 
ENDIF 
C 

IDEPS  =  IDEPS  +  NWCI) 
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lAVS  =  lAVS  +  AINVAL(I)  +0.5 
lALL  =  lALL  +  AINVT(I)  +0.5 
lUALL  =  lUALL  +  AINV(I) 

C  Convert  to  integer... 

IINVAL  =  AINVAL(I)  +  0.5 
IINVWL  =  AINVWL(I)  +0.5 
IINVRL  =  AINVRL(I)  +  0.5 
IINVNS  =  AINVNS(I)  +  0.5 
IINVT  =  AINVT(I)  +  0.5 
IFCIPLS.EQ. '2')  THEN 

WRITE (LU, 3000)  ' | ' ,WNAM(I) ,WCAT(I) ,WLEG(I) ,WPR(I) ,M0BW(I) , 

+  WTU(I),NW(I),IINVAL,IINVWL,IINVRL.IINVT,AINV(I),' I ' 

ELSE 

WRITE(LU,3030)  ' | ' .WNAM(I) ,WCAT(I) ,WLEG(I) ,WPR(I) ,M0BW(I) , 
+  WTU(I), NW(I), IINVAL, IINVWL, IINVRL, IINVNS, IINVT, AINV(I), ' I ' 
ENDIF 
C 

145  LX  =  1 

IFCARATE.EQ. 'G' .AND.AORDER.EQ. '1')  LX  =  2 
DO  150  K1  =  1,N0BJ 
J  =  IPRIO(Kl) 
lOBJT  =  lOBJT  +  TNUM(J) 

IX  =  I 

IB  =  INDX(K1,1) 

IE  =  INDX(K1,2) 

DO  155  L  =  1,LX 
NTOT(L)  *  0 
IF(L.EQ.2)  IX  =  IN 
IF(IB.EQ.O)  GOTO  155 
DO  160  K  =  IB, IE 
DO  160  K2  =  1,2 

IF(ATNUM(K).EQ.O)  GOTO  160 
IF(AWTyP(K,K2).EQ.IX)  THEN 
NTOT(L)  =  NTOT(L)  +  ATNUM(K) 

IF(WPT(K).GT.l)  NTOT(L)  =  NTOT(L)  +  ATNUM(K) 

ENDIF 

160  CONTINUE 

155  CONTINUE 

C 

N1N2  =  0 

DO  170  IL  =  1,LX 

N1N2  =  N1N2  +  NTOT(IL) 
lAALL  =  lAALL  +  NTOT(IL) 

IF(IL.EQ.l)  IDALL  =  IDALL  +  NTOT(IL) 

IF(IL.EQ.2)  IGALL  =  IGALL  +  NTOT(IL) 

170  CONTINUE 

IF(N1N2.EQ.0)  GO  TO  150 

IF (ARATE . EQ . ' G ' . AND . AORDER . EQ . ' 1 ' )  THEN 

WRITE(LU,3015)  ' 1 ' ,TOBJ(J) ,NT0T(1) ,NT0T(2) , ' | ' 

ELSE 

WRITE(LU,3010)  ' I' ,TOBJ(J) ,NT0T(1) , ' I' 
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ENDIF 
150  CONTINUE 
C 

100  CONTINUE 
C 

WRITE(LU,3020)  '| 
' _ 


I F ( AR ATE . EQ . ' G ' . AND . AORDER . EQ . ’ 1 ' )  THEN 
IFCIPLS.EQ. '2')  THEN 

WRITE(LU,3002)  '|','ALL  WEAPONS' ,IDEPS,IAVS,IWHS,IARS, 
+  IALL,IDALL,IGALL,IUALL,’ r 

ELSE 

WRITE (LU, 3032)  ' | , 'ALL  WEAPONS' ,IDEPS,IAVS,IWHS,IARS, 
+  ISALL,IALL,IDALL,IGALL,IUALL,' I  ' 

ENDIF 

ELSE 

IFCIPLS.EQ. '2')  THEN 

WRITE (LU, 3005)  '1','ALL  WEAPONS' ,IDEPS,IAVS,IWHS,IARS, 
+  lALL.IAALL.IUALL,' r 

ELSE 

WRITE (LU, 3035)  '|','ALL  WEAPONS' ,IDEPS,IAVS,IWHS,IARS, 
+  ISALL,IALL,IAALL,IUALL,'r 

ENDIF 
ENDIF 

WRITE (LU, 3020)  '  Vf***>V******>V*>V*5VVlr***>V*******iV**iV*iV*iVA*»'r***’  ^ 

4-  '  yif^WfVfVnV*****!??************************************* '  ^ 

4-  '  *?V*****Vf*****A*iV ' 

C 

C  Write  summary  tables... 

CALL  R0UT20(LU) 

CALL  R0UT21(LU) 

CALL  R0UT22(LU) 

C 

3000  F0RMAT(13X,A1,1X,A10,1X,A4,2X,A1,1X,I3,1X,A1,2X,I1,1X,I5,3X, 
+  I5,2X,I4,2X,I4,7X,I4,30X,I6,3X,A1) 

3002  F0RMAT(13X,A1,1X,A11,17X,I5,3X,I5,2X,I4,2X,I4,6X,I5,18X,I4. 

+  'd',lX.I4,'g',lX,I6,3X,Al) 

3005  F0RMAT(13X,A1,1X,A11,17X,I5,3X,I5,2X,I4,2X,I4,6X,I5,20X,I5, 

+  5X,I6,3X,A1) 

3010  F0RMAT(13X,A1,70X,A12,3X,I5,14X,A1) 

3015  F0RMAT(13X,Al,70X,A12,lX,I4,'d' ,lX,I4,'g' ,10X,A1) 

3020  F0RMAT(13X,A41,A49,A16) 

3030  F0RMAT(13X,A1,1X,A10,1X,A4,2X,A1,1X,I3,1X,A1,2X,I1,1X,I5,3X, 
+  I4,2X,I4,2X,I3,1X,I4,4X,I4,30X,I6,3X,A1) 

3032  F0RMAT(13X,A1,1X,A11,17X,I5,3X,I4,2X,I4,2X,I3,1X,I4,4X,I4, 

+  18X,I4,'d' ,lX,I4,’g' ,1X,I6,3X,A1) 

3035  F0RMAT(13X,A1,1X,A11,17X,I5,3X,I4,2X,I4,2X,I3,1X,I4,4X,I4, 

+  20X,I5,5X,I6,3X,A1) 

C 

RETURN 
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C 

END 
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SUBROUTINE  RPOUT3(LU) 

C 

C  RP0UT3  displays  the  time-ordered  summary  allocation  by  scenario. 
C  LU  is  the  logical  unit  to  which  output  is  sent. 

C 

IMPLICIT  INTEGER*4  (I-N) 

INTEGER*2  LU 
C 

C  Notes:  NUMSW  is  the  total  number  of  weapons  allocated. 

C  NUMS  counts  targets  covered  by  weapons. 

C 

$  INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PDES.CDE' 

$ INCLUDE:  'PRINT. CDE' 

§ INCLUDE:  'PRIO.CDE' 

$ INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'TARGT.CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  NUMS(3,20) ,WDEC(3,20) ,DEIO(3,20) ,INDEX(3) , 

+  NUMSW(3,20) ,DEST(4) ,NUMT(4) ,NUMTT(4) ,DEALL(4) 

C 

DO  50  150  =  1,4 
C 

IF(IPRCRX.EQ.1.AND.I50.NE.ISC)  GOTO  50 
IF(ISC.LT.3.AND.I50.GE.3)  GOTO  50 
ITTOT  =  0 
TODEl  =  0 
TODE2  =  0 
NOHITT  =  0 
INTXT  =  0 
DO  55  I  =  1,4 
DEALL(I)  =  0. 

55  NUMTT(I)  =  0 
C 

CALL  R0UT30(LU,I50) 

C 

C  Sort  the  targets  by  timing  requirement... 

DO  90  IT  =  1,3 

IF(IT.EQ.l)  WRITE(LU,3030)  '  TIME -URGENT  TARGETS  ' 

IF(IT.EQ.2)  WRITE(LU,3030)  '  TIME-SENSITIVE  TARGETS  ' 

IF(IT.EQ.3)  WRITE(LU,3030)  '  NON-TIME-SENSITIVE  TARGETS  ' 

WRITE (LU, 3055) 

C 

DO  100  I=l,NOBJ 
I COP  =  I 
ICO  =  IPRIO(I) 

K  =  ICO 

IF(TUR(K).NE. (IT))  GO  TO  100 
Initialize. . . 


C 


a  n 
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INTX  =  0 

C  Loop  through  the  weapon  timing  capabilities... 

DO  120  IW  =  1,3 
INDEX(IW)  =  0 
DO  120  IW2  =1,20 
NUMS(IW,IW2)  =  0 
NUMSW(IW,IW2)  =  0 
WDEC(IW,IW2)  =  0. 

120  DEI0(IW,IW2)  =  0. 

C 

CALL  UOUT ( 1 5 0 , 1 NTX , NUMSW , NUMS , INDEX , WDEC) 

Get  the  total  DE  for  this  objective... 

DETOT  =  0. 

DET  =  0. 

NUMT(4)  =  0 
DEST(4)  =  0 
DO  125  IM  =  1,3 
DET  =  0. 

DEST(IM)  =  0. 

NUMT(IM)  =  0 

IF(INDEX(IM).EQ.O)  GOTO  125 
DO  127  ID=1,INDEX(IM) 

NUMT(IM)  =  NUMT(IM)  +  NUMSW(IM,ID) 

NUMT(4)  =  NUMT(4)  +  NUMSW(IM,ID) 

DET  =  DET  +  NUMS(IM,ID)*WDEC(IM,ID) 

DEIO(IM,ID)  =  (DETOT+DET)/TNUM(K) 
IF(DEIO(IM,ID).GT.DEST(IM))  DEST(IM)  =  DEIO(IM,ID) 
IF(DEST(IM).GT.DEST(4))  DEST(4)  =  DEST(IM) 

127  CONTINUE 

DEALL(IM)  =  DEALL(IM)  +  DET 
DEALL(4)  =  DEALL(4)  +  DET 
125  DETOT  =  JETOT  +  DET 

C 

DO  130  1130  =2,3 

130  IF(DEST(I130).EQ.0)  DEST(I130)  =  DEST(I130-1) 

C 

IF(i50.LT.3)  THEN 
NOKTT  =  NOHITl(K) 

ELSE 

.NOHIT  •-  NOHIT2(K) 

ENDIF 

C 

IFdSSPK.EQ.  '2')  THEN 

WRITE(LU,301S)  OPR(K)  ,TOBJ('.)  ,TNUM(K)  ,M0BT(K)  , 

+  VNTK1(K),0DE1(K),0DE2(K), 

+  NOHIT , INTX . NUMT ( 1 ) , DEST ( 1 ) , NUMT ( 2 ) , DEST ( 2 ) , 

+  NUMT(3) ,DEST(3) ,NUMT(4) ,DEST(4) 

ELSE 

WRITE(LU,3010)  OPR(K) ,TOBJ(K) ,TNUM(K) ,H0BT(K) , 

VNTKl(K)  ,V.NTK2(K)  ,VNTK3(K)  ,0DE1(K)  ,ODE2(K)  , 


+ 
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+  NOH IT , I NTX , NUMT ( 1 ) , DEST ( 1 ) , NUMT ( 2 ) , DEST ( 2 ) , 

+  NUMT(3) ,DEST(3) ,NUMr(4) ,DEST(4) 

ENDIF 

C 

ITTOT  =  ITTOT  +  TNUM(K) 

TODEl  =  TODEl  +  ODEl (K)*TNUM(K) 

TODE2  =  TODE2  +  ODE2(K)*TNUM(K) 

NOHITT  =  NOHITT  +  NOHIT 
INTXT  =  INTXT  +  INTX 
DO  105  1105  =  1,4 

105  NUMTT(I105)  =  NUMTT(I105)  +  NUMT(I105) 

C 


100  CONTINUE 

WRITE (LU, 3045)  '| . . 

+  ' . 

+ ' . r 


90  CONTINUE 
C 


IF(ITTOT.NE.O)  TODEl  =  TODEl/ITTOT 
IF ( ITTOT. NE.O)  TODE2  =  T0DE2/ ITTOT 
DO  95  195  =  2,3 

DEALL(I95)  =  DEALL(I95)  +  DEALL(I95-1) 

95  CONTINUE 

DEALL(4)  =  DEALL(3) 

DO  98  198  =  1,4 

98  DEALL(I98)  =  DEALL(I98)/ITTOT 
C 

WRIT':(LU,3050)  'ALL  TARGETS  ', ITTOT, TODEl, TODE2, NOHITT, INTXT, 
+  NUMTT ( 1 ) , DE ALL ( 1 ) , NUMTT ( 2 ) , DE ALL ( 2 ) , NUMTT ( 3 ) , DEALL ( 3 ) , 

+  NUMTT(4),DEALL(4) 

C 

3010  F0RMAT(8X,' I ',I3,1X,A12,1X,I4,1X,A1,2X,I2,A1,A1,2(2X,F4.3), 

+  2X,I5,5X,I5,4X,4(2X,I5,2X,F4.3),1X, 'I') 

3015  F0RMAT(8X, ' | ' , 13 , IX, A12 , IX, 14, 1X,A1 , 2X, 15 , 1X,2( 1X,F4 . 3) , 

+  3X,I5,5X,I5,4X,4(2X,I5,2X,F4.3),1X, 'I') 

3030  F0RMAT(8X, ' r ,A30,85X,' I') 

3045  F0RMAT(8X,A42,A52,A23) 

3050  F0RMAT(8X, ' | ' ,4X,A12 , IX, I4,8X,2(2X,F4 . 3) ,2X, 15 ,5X, 15 ,4X, 

+  4(2X,I5,2X,F4.3),1X,' I') 

3055  FORMAT(8X,'|',115X,'r) 

C 


WRITE(LU,3045)  '*• 


^ 


c 

50  CONTINUE 
C 

1000  CONTINUE 
C 


RETURN 
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C 

END 
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SUBROUTINE  RPOUT4(LU) 

C 

C  RP0UT4  displays  the  time-ordered  allocation 
C  by  target  groups.  LU  is  the  logical  unit  to 
C  which  output  is  sent. 

C 

IMPLICIT  INTEGERS  (I-N) 

INTEGER*2  LU 

INTEGER*4  TTARG(5) ,TG0(5) 

CHARACTER*3  TITLE (5) 

CHARACTER* 12  NAMET 

DIMENSION  NUMS(3,20),WDEC(3,20),DEI0(3,20),INDEX(3), 

+  Nl'MT(4,5) ,DEST(4,5) ,G0DE1(5) ,GODE2(5) ,INTT(5) , 

+  NUMSW(3,20),NUMTT(4),DEALL(4) 

C 

C  Notes:  NUMSW  is  the  total  number  of  weapons  allocated. 

C  NUMS  counts  targets  covered  by  weapons. 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PDES.CDE' 

$INCLUDE:  'PRINT. CDE' 

$INCLUDE:  'PRIO.CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

DATA  TITLE  /'NUC' , 'LDR' , 'OMT' , 'ECN' , 'DEF'/ 

C 

DO  10  ISO  =  1,4 
C 

IFdPRCRX.EQ.l.AND.ISO.NE.ISC)  GOTO  10 
IF(ISC.LT.3.AND.I50.GE.3)  GOTO  10 
ITTOT  =  0 
TODEl  =  0 
TODE2  =  0 
NOHITT  =  0 
INTXT  =  0 
DO  55  I  =  1,4 
DEALL(I)  =  0. 

55  NUMTT(I)  =  0 
C 

CALL  ROUT40(LU,I50) 

C 

C  Sort  the  targets  by  timing  requirement... 

DO  90  IT  =  1,3 

IF(IT.EQ.l)  WRITE(LU,3040)  '  TIME-URGENT  TARGETS  ' 

IF(IT.EQ.2)  WRITE(LU,3040)  '  TIME-SENSITIVE  TARGETS  ' 

IF(IT.EQ.3)  WRITE(LU,3040)  '  NON-TIME-SENSITIVE  TARGETS  ' 

WRITE (LU, 3055) 

DO  92  192  =  1,5 
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TTARG(I92)  =  0 
G0DE1(I92)  =  0 
G0DE2(I92)  =  0 
TG0(I92)  =  0 
INTT(I92)  =  0 
DO  92  19  =  1,4 

NUMT(I9,I92)  =  0 
DEST(I9,I92)  =  0. 

92  CONTINUE 
C 

DO  100  ICOMP  =  1,5 
DO  100  I=l,NOBJ 
ICOP  =  I 
ICO  =  IPRIO(I) 

K  =  ICO 

NAMET  =  TOBJ(K) 

IF(NAMET( 1: 3). NE. TITLE (ICOMP))  GOTO  100 
IF(TUR(K).NE.IT)  GO  TO  100 

C  Loop  through  the  weapon  timing  capabilities... 

INT  =  0 

DO  120  IW  =  1,3 
INDEX (IW)  =  0 
DO  120  IW2  =1,20 
NUMS(IW,IW2)  =  0 
NUMSW(IW,IW2)  =  0 
WDEC(IW,IW2)  =  0. 

DEIO(IW,IW2)  =  0. 

120  CONTINUE 

C 

CALL  UOUT ( 1 5 0 , 1 NT , NUMSW , NUMS .INDEX, WDEC ) 

C 

DO  125  IM  =  1,3 

IF(INDEX(IM).EQ.O)  GO  TO  125 
DO  127  ID=1,INDEX(IM) 

NUMTCIM,  ICOMP)  =  NUMTdM,  ICOMP)  +  NUMSW(IM,ID) 

NUMT(4, ICOMP)  =  NUMT(4, ICOMP)  +  NUMSW(IM,ID) 

DEST( IM .ICOMP)  =  DEST( IM , ICOMP)+NUMS ( IM , ID)*WDEC ( IM , ID) 
DEALL(IM)  =  DEALL(IM)  +  NUMS(IM,ID)*WDEC(IM,ID) 

DEALL(4)  =  DEALL(4)  +  NUMS(IM, ID)*WDEC(IM, ID) 

127  CONTINUE 

125  CONTINUE 

C 

mRG(ICOMP)  =  TTARG(ICOMP)  +  TNUM(K) 

IF(I50.LT.3)  THEN 
NOHIT  =  NOHITl(K) 

ELSE 

NOHIT  =  NOFIT2(K) 

END  IF 
C 

ITTOT  =  ITTOT  +  TNUM(K) 

TODEl  =  TODEl  +  0DE1(K)*TNUM(K) 
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T0DE2  =  T0DE2  +  0DE2(K)*TNUM(K) 

NOHITT  =  NOHITT  +  NOHIT 
INTXT  =  INTXT  +  INT 
C 

TGO(ICOMP)  =  TGO(ICOMP)  +  NOHIT 
INTT(ICOMP)  =  INTT(ICOMP)  +  INT 
GODEl(ICOMP)  =  GODEl(ICOMP)  +  ODEl(K)*TNUM(K) 

GODE2(ICOMP)  =  GODE2(ICOMP)  +  ODE2(K)*TNUM(K) 

C 

100  CONTINUE 
C 

DO  95  195=1,5 

IF(TTARG(I95).NE.O)  THEN 

DEST(4,I95)  =  (DEST(1,I95)+DEST(2,I95)+DEST(3,I95)) 

+  /TTARG(I95) 

IF(DEST(3,I95).NE.O)  DEST(3,I95)  = 

+  (DEST(1,I95)+DEST(2,I95)+DEST(3,I95))/TTARG(I95) 

IF(DEST(2,I95).NE.O)  DEST(2,I95)  = 

+  (DEST(1,I95)+PEST(2,I95))/TTARG(I95) 

IF(DEST(l,I95).NE.O)  DEST(1,I95)  =  DEST(1,I95)/TTARG(I95) 
ENDIF 

DO  130  II  =  2,3 

130  IF(DEST(II,I95).EQ.O)  DEST(II,I95)  =  DEST(II-1 , 195) 

IF(TTARG(I95).NE.O.)  G0DE1(I95)  =  G0DE1(I95)/TTARG(I95) 
IF(TTARG(I95).NE.O.)  G0DE2(I95)  =  GODE2(I95)/TTARG(I95) 
WRITE(LU,3015)  TITLE(I95) ,TTARG(I95) ,G0DE1(I95) ,G0DE2(I95) , 

+  TG0(I95),INTT(I95),NUMT(1,I95),DEST(1,I95),NUMT(2,I95), 

+  DEST(2,I95),NUMT(3,I95),DEST(3,I95),NUMT(4,I95),DEST(4,I95) 

C 

DO  105  1105  =  1,4 

105  NUMTT(I105)  =  NUMTT(I 105)+NUMT(I 105 , 195) 

C 

95  CONTINUE 
C 

WRITE (LU, 3045)  '| . ', 

'  I 


90  CONTINUE 

IF(ITTOT.NE.O)  TODEl  =  TODEl/ITTOT 
IF(ITTOT.NE.O)  T0DE2  =  T0DE2/ITT0T 
DO  196  196  =  2,3 

196  DEALL(I96)  =  DEALL(I96)  +  DEALL(I96-1) 

DEALL(4)  =  DEALL(3) 

DO  195  195  =  1,4 

IF(ITTOT.NE.O)  DEALL(I95)  =  DEALL(I95)/ITTOT 
195  CONTINUE 

WRITE(LU,3050)  'ALL  TARGETS  ', ITTOT, TODEl ,T0DE2 , NOHITT, INTXT, 
+  NUMTT ( 1 ) , DEALL ( 1 ) , NUMTT ( 2 ) , DEALL ( 2 ) , NUMTT ( 3 ) , DE ALL ( 3 ) , 

+  NUMTT (4 ), DEALL (4) 
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WRITE  ( LU ,  3045 )  '  *****iv**5V***A***?v**iVVfVf5V*A**********5V'!V*A 

+  '  Vf*5V*‘.V*iMf***5V*Vf****Vf.V*Vf*VfVf.VVf*5V5V:V*A*****5V?V!V******;V**iWr ' 

+  '  Vf**5VV:Vf*Vf****Vf5V****,V*i'f* ' 


10  CONTINUE 


C 

3015  FORMATdOX,'  r,2X,A3,7X,I5,6X,2(2X,F4.3),2X,I5,5X,I5, 
+  4X,4(2X,I5,2X,F4.3),3X,' I') 

3040  FORMATdOX,' r,A30,81X,' I') 

3045  FORMATdOX, A40,A52,A21) 

3050  FORMATdOX,'  I  ' ,  1X,A11,I5,6X,2(2X,F4.3)  ,2X,I5,5X,I5, 

+  4X,4(2X,I5,2X,F4.3),3X,' I ') 

3055  FORMATdOX,' I ',111X,' I') 

C 


RETURN 


C 


END 


o  o  o  o 
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SUBROUTINE  SCNDE1(I1,SCDE,IW) 

C 

C  SCNDEl  calculates  the  scenario  DE  for  a  single  weapon 
C  against  a  target,  where: 

C  II  -  the  index  of  the  DEA  array 

C  SCDE  -  the  current  DE  (the  DE  for  the  allocation  scenario) 

IW  -  the  index  of  the  weapon  being  evaluated  in  the 
current  scenario 

Results  are  stored  in  DEA(Il,i)  where  i=l,4  for  each  of  the  four  scenarios. 

IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

C  Calculate  the  values  for  the  DEA  array... 

DO  100  I  =  1,4 

IF(ISC.EQ.I)  GOTO  100 
DEA(I1,I)  =  0. 

IF(IW.EQ.O)  GOTO  100 
PLSI  =  PLSSdW.I) 

IFdPLS.EQ.  '1')  PLSI  =  1.0 
IFCSCDE.NE.O.)  DEACIl,!) 

+  =  SCDE*PLSI*PTPSdW,I)/(PLSdW)*PTPdW)) 

100  CONTINUE 
C 

RETURN 

C 

END 


oooooonooooooo 
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SUBROUTINE  SCNDE2( II , SCDE1 , IWl , SCDE2, IW2) 

SCNDE2  calculates  the  scenario  DE  for  a  pair  of  weapons 
against  a  target,  where: 

II  -  the  index  of  the  DEA  array 

SCDEl  -  the  current  DE  (the  DE  for  the  allocation  scenario) 
of  the  first  weapon  in  the  pair 
IWl  -  the  index  of  the  first  weapon  being  evaluated  in  the 
current  scenario 

SCDE2  -  the  current  DE  (the  DE  for  the  allocation  scenario) 
of  the  second  weapon  in  the  pair 
IW2  -  the  index  of  the  second  weapon  being  evaluated  in  the 
current  scenario 

Results  are  stored  in  DEA(Il,i)  i=l,4  for  each  of  the  four  scenarios. 

IMPLICIT  INTEGER*4  (I-N) 

CHARACTER*8  NAME 
C 

$ INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

C  Calculate  the  values  for  the  DEA  array. . . 

DO  100  I  =  1,4 

IF(ISC.EQ.I)  GOTO  100 
DEA(I1,I)  =  0. 

DEAW  =  0. 

DEAW2  =  0. 

PLSl  =  PLSS(IW1,I) 

PLS2  =  PLSS(IW2,I) 

IFdPLS.EQ. '!’)  THEN 
PLSI  =1.0 
PLS2  =1.0 
ENDIF 

NAME  ='WNAM(IW1) 

IF(.N0T.(I.LT.3.AND.NAME(1:1).EQ. 'g')) 

+  DEAW  =  SCDE1*PLSI*PTPS(IW1,I)/(PLS(IW1)*PTP(IW1)) 

NAME  =  WNAM(IW2) 

IF(.N0T.(I.LT.3.AND.NAME(1:1).EQ. 'g')) 

+  DEAW2  =  SCDE2*PLS2*PTPS(IW2,I)/(PLS(IW2)*PTP(IW2)) 

DEAdl.I)  =  1.-  :i.-DEAW)*(l-DEAW2) 

100  CONTINUE 
C 

RETURN 

C 

END 
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SUBROUTINE  SCNDE3( IW,  ISX,SDE) 

C 

C  SCNDE3  calculates  the  scenario  DE  for  a  single  weapon 
C  against  a  target,  where: 

C  IW  -  is  the  index  of  the  weapon  to  be  evaluated 

C  ISX  -  the  index  of  the  scenario  to  be  evaluated 

C  SDE  -  the  scenario  DE  (an  output  variable) 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$  INCLUDE:  'OBJ.CDE* 

$  INCLUDE:  'RULES.CDE' 

$  INCLUDE:  'SSPKDE.CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

K  =  ICO 

IF(IW.EQ.O)  RETURN 
PLSI  =  PLSS(IW,ISX) 

IFdPLS.EQ. '1')  PLSI  =  1.0 

SDE  =  DE(K,IW)*PLSI*PTPS(IW,ISX)/(PLS(IW)*PTP(IW)) 
C 

RETURN 

C 

END 


o  ra  o 
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C 


SUBROUTINE  SETDEF 

IMPLICIT  INTEGER*4  (I-N) 


SETDEF  sets  the  default  values  for  the  rules. 

§ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'PRINT. CDE' 

§ INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

ARATE  =  'G' 

AORDER  =  '2' 

CASE  =  'P' 

IPRINT  =  0 
ISSPK  =  '3' 

IPLS  =  '2' 

ARWOC  =  '2' 

IPASS2  =  '2' 

IDEP(l)  =  '1' 

IDEP(2)  =  '2' 

ARLEG  =  '2' 

ARSAM  =  '2' 

C 

PORDER  =  ' 1 ' 

P2(2,l)  =  '2' 

ARTU  =  '2' 

P2(2,2)  =  '2' 

ARDE  =  '2' 

P2(2,3)  =  '2' 

ARMOF  =  '2' 

P2(2,4)  =  '2' 

ARFOM  =  '2' 

P2(2,5)  =  '2' 

C 

MAXOBJ  =  300 
NMAX  =  60 
TPl  =  1 
TP2  =  999 
C 

RETURN 

C 


END 
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SUBROUTINE  SSPKT 

C 

C  SSPKT  operates  on  the  SSPK  data  -  input  by  the  user,  calculated  by  PDCALC 
C  or  determined  by  the  equation  -  to  create  a  DE  table  (really  a  weapon- 
C  target-vulnerability  table).  All  DE  values  are  checked  -  if  a  zero  DE  is 
C  found,  FALCON  execution  terminates. 

C 

C 

IMPLICIT  INTEGERS  (I-N) 

C 

CHARACTER*70  TLINE(IO) 

C 

^INCLUDE:  'FDNAM.CDE' 

$ INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' PRINT. CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  ' WEARS. CDE' 

C 

CHARACTER*126  LINE 
CHARACTER*12  TSSPK(IOO) 

CHARACTER*10  WSSPK(60) ,WNAM2 
CHARACTER*!  LI 
DIMENSION  SSPKI(100,60) 

C 

C  Read  in  or  calculate  the  SSPK  table: 

C 

C  Read  in  the  SSPK  data... 

IFCISSPK.NE. '2' .AND.ISSPK.NE. '3')  THEN 

WRITE(*,*)  'Enter  the  name  of  the  SSPK  Data  Input  File:  ' 

WRITE (*,*)  '  (max  8  characters  plus  3-character  extent)  ' 

READ (*,3090)  SFNAME 
WRITE(15,2990) 

WRITE (15, 20 15)  'SSPK  FILE  USED:  ', SFNAME 
WRITE(16,2990) 

WRITE(16,2015)  'SSPK  FILE  USED:  '.SFNAME 
0PEN(10,FILE=SFNAME) 

I  =  0 
IR  =  0 
ITN  =  0 
ILINE  =  0 

100  READ  (10,3000,END=800)  LINE 
ILINE  =  ILINE  +  1 

IF(LINE(1:10).EQ. '  ')  GOTO  100 

READ(LINE,3000)  LI 
IF(L1.EQ. 'C')  GO  TO  100 
IF(L1.EQ. 'E')  GO  TO  800 
IF(L1.EQ. 'T')  THEN 
ITN  =  ITN  +  1 
IF(ITN.GT.IO)  GO  TO  100 
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TLINE(ITN)  =  LINE(1;70) 

IF(IPRINT.NE.O)  WRITE (15, 3005)  TLINE(ITN) 

GO  TO  100 
ENDIF 

IF(L1,EQ. '*')  THEN 
IS  =  1*5  +  1 
IE  =  IS  +  4 
1  =  1  +  1 

READ(LINE,3010,ERR=499,END=100)  (TSSPK(J) , J=IS, IE) 

GOTO  100 
ELSE 

IR  =  IR  +  1 

READCLINE , 3020 ,ERR=499 ,END=100)  WSSPK(IR) , 

+  (SSPKI(J,IR),J=IS,IE) 

GOTO  100 
ENDIF 

800  CONTINUE 

IF(ILINE.EQ.O)  GOTO  399 
C 

C  Make  these  consistent  with  weapons/targets  data  as  entered... 

DO  200  1=1, NOB J 
DO  200  J=l,NWTyP 
DO  200  K=1,IE 
DO  200  L=1,IR 

IF(SSPKI(K,L).EQ.O)  GOTO  200 
WNAM2  =  WNAM(J) 

IF(ARATE.EQ. 'G' .AND.AORDER.EQ. '1')  WNAM2  =  WNAM2(3:10) 
IF(WSSPK (L) . EQ . WNAM2 . AND .TSSPK (K) . EQ . TOB J ( I ) )  THEN 
DE(I,J)  =  SSPKKK.L) 

ENDIF 
200  CONTINUE 
C 

IF(IPRINT.NE.O)  THEN 
WRITE (15,*) 

WRITE(15,*)  'SSPKT:  Reading  SSPK  data  as  input  ' 

WRITE (15,*) 

CALL  WRSSPK(15) 

ENDIF 
CLOSE (10) 

ENDIF 

C 

IFdSSPK.EQ.  '2'  .OR.ISSPK.EQ.  '4')  THEN 
DO  300  I  =  l,NOBJ 
DO  300  J  =  1,NWTYP 

IFdSSPK.EQ. '4' .AND. DE(I,J).NE.O)  GOTO  300 
C  Calculate  the  lethal  radius... 

HD  =  VNTKl(I) 

D23  =  2./3. 

RL  =  (3.48  +  SQRT(12.1+3.3*HD))/HD 
RL  =  1000.*RL**D23 

YEXP  =  (YLD(J)**D23)*(RL/CEP(J))*(RL/CEP(J)) 


o  o  o 
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DE(I,J)  =  l.-0.5**YEXP 
300  CONTINUE 

IF(IPRINT.NE.O)  THEN 
WRITE(15,*) 

WRITE(15,*)  'SSPKT:  Calculating  SSPKs  from  formula  -  ’ 
WRITE(15,*) 

CALL  WRSSPK(15) 

ENDIF 
GOTO  500 
ENDIF 
C 

IFdSSPK.EQ.  '3'  .OR.ISSPK.EQ.  '5')  THEN 
CALL  PDCALC 
IF(IPRINT.NE.O)  THEN 
WRITE (15,*) 

WRITE(15,*)  'SSPKT:  Incorporating  SSPKs  from  PDCALC  -  ' 
WRITE(15,*) 

CALL  WRSSPK(15) 

ENDIF 

ENDIF 

C 

500  CONTINUE 
C 

C  Account  for  Pre-launch  survivability... 

C 

DO  103  I=l,NOBJ 
DO  103  J=1,NWTYP 

DE(I,J)  =  DE(I,J)*PLS(J) 

103  CONTINUE 

Account  for  reliability... 

DO  no  I=l,NOBJ 
DO  110  J=1,NWTYP 

DE(I,J)  =  DE(I.J)*RELL(J)*RELI(J)*RELV/(J) 
no  CONTINUE 
C 

C  Probability  to  Penetrate... 

DO  180  I=l,NOBJ 
DO  185  J=1,NVTYP 

185  DE(I,J)  =  DE(I,J)*PTP(J) 

180  CONTINUE 

IF(IPRINT.EQ.2)  THEN 
WRITE (15,*) 

WRITE(15,3015)  'WEAPON -TARGET  DAMAGE  EXPECTANCY  MATRIX  -' 
WRITE(15,*) 

CALL  WRSSPK(15) 

ENDIF 

WRITE(16,2990) 

WRITE (16, 30 15)  'WEAPON -TARGET  DAMAGE  EXPECTANCY  MATRIX  -' 


o  o 
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WRITE (16,*) 

CALL  WRSSPK(16) 


Check  values  for  zero  DEs... 

DO  190  I=1,N0BJ 
DO  195  J=1,NWTYP 

IF(DE(I,J).EQ.O.)  THEN 

WRITE (15,*)  'SSPKT  :  Error  in  DE  calculations 
WRITE(15,*)  '  Zero  DE  not  allowed  for  ',WNAM(J) 

WRITE(15,*)  '  and  target  ',T0BJ(I) 

WRITE(15,*)  'FALCON  Stopping.' 

WRITE(*,*)  'SSPKT  :  Error  in  DE  calculations  -' 
WRITE(*,*)  '  Zero  DE  not  allowed  for  ' ,WNAM(J) 

WRITE(*,*)  '  and  target  ' ,T0BJ(I) 

WRITE(*,*)  'FALCON  Stopping. ' 

STOP 
ENDIF 
195  CONTINUE 
190  CONTINUE 
C 

2015  FORMAT(A16,A12) 

2990  F0RMAT(///) 

3000  FORMAT(A) 

3005  FORMAT(A70) 

3010  F0RMAT(12X,5(A12,1X)) 

3015  F0RMAT(A40) 

3020  FORMAT( IX , AlO , IX , 5 (F4 . 3 , 9X) ) 

3030  FORMAT(A38,A53.A36) 

3090  F0RMAT(A12) 

C 

RETURN 

C 

399  WRITE(*,*)  'SSPKT:  Error  in  reading  SSPK  data  or' 

WRITE(*,*)  '  file  not  found.  FALCON  stopping.' 

STOP 

WRITE(15,*)  'SSPKT:  Error  in  reading  SSPK  data  or' 

WRITE(15,*)  '  fila  not  found.  FALCON  stopping.' 

STOP 

C 

499  WRITE(*,*)  'SSPKT:  Error  in  reading  SSPK  data  file.  Line  was:' 
WRITE (*,*)  '  ',LINE 

WRITE(*,*)  'FALCON  stopping.' 

STOP 

WRITE(15,*)  'SSPKT;  Error  in  reading  SSPK  data  file.  Line  was;' 
WRITE (15,*)  '  ',LINE 

WRITE(15,*)  'FALCON  stopping.' 

STOP 

C 

END 
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SUBROUTINE  SWOC(INDEX,INDXI) 

C 

C  SWOC  selects  the  weapon(s)  of  choice  for  a  given 
C  woe  selection,  W0C(IC0, INDEX) ,  where  WOC  and  ICO 
C  are  read  from  labelled  common  and  INDEX,  either  1  or  2,  is  an  input 
C  parameter  indicating  whether  the  first  or  second  weapon  of  choice 
C  is  being  used.  The  list  of  allowable  weapons  of  choice 
C  is  printed  (using  the  local  array,  AWW)  and  a  weapon 
C  is  selected,  lUSE(INDXI),  returned  through  labelled 
C  common.  INDXI,  either  1  or  2,  is  an  input  parameter  tailing 
C  whether  one  or  two  weapons  are  selected  as  the  weapon t,s)  of  choice. 
C 

IMPLICIT  INTEGER*^  (I-N) 

C 

CHARACTER* 12  CTMP , CNAM , CWNAM 
CHARACTER*4  CNOT 
CHARACTER*!  CLEG, AWW (60) 

C 

$  INCLUDE:  'AWEAPS.CDE' 

$  INCLUDE:  'OBJ.CDE* 

$  INCLUDE:  ' PRINT. CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

C  Initialize  the  name  variables... 

CTMP  =  WOC (ICO, INDEX) 

CNAM  =  CTMP 
CNOT  =  '  ' 

IF(CNAM(1:4).EQ. 'NOT. ')  THEN 
CNAM  =  CTMP(5:12) 

CNOT  =  'NOT. ' 

ENDIF 

C 

C  Check  whether  WOC  specifies  a  leg... 

IF(CNAM.EQ.'lCBM'.OR.CNAM.EQ.'SLBM'.OR.CNAM.EQ.'AIR  ')  THEN 
CLEG  =  CNAM(1:1) 

DO  200  I  =  l.NSALL 
IDX  =  IDXSA(I) 

AW'W(I)  =  'N' 

IF((CN0T.EQ. '  ' .AND.CLEG.EQ.WLEG(IDX)).OR. 

+  (CNOT.EQ. 'NOT. ' .AND. CLEG. NE.WLEG( IDX)))  AWW(I)  =  'Y' 

200  CO.NTINUE 
C 

C  Check  whether  WOC  specifies  a  type... 

ELSEIF  (CNAM.EQ. 'SILO' . OR. CNAM. EQ. ' RAIL' .OR. CNAM. EQ. 'ROAD' 

+  .OR. CNAM.EQ. 'PORT' .OR. CNAM.EQ. 'SEA  ' .OR. CNAM.EQ. 'STA  ' 

+  . OR . CNAM . EQ . ' ALCM ' . OR . CNAM . EQ . ' GRAV ' . OR . CNAM . EQ . ' SRAM ' )  THEN 

DO  300  I  =  l.NSALL 
IDX  =  IDXSA(I) 

AWW(I)  =  'N' 

IF((CNOT.EQ. '  ' .AND. CNAM.EQ. WCAT( IDX)). OR. 

+  (CNOT.EQ. 'NOT.  '  .AND. CNAM. NE.WCAT( IDX)))  AW’W'(I)  =  'Y' 
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300  CONTINUE 
C 

C  Check  whether  WOC  specifies  a  particular  weapon... 

ELSE 

DO  400  I  =  l.NSALL 
IDX  =  IDXSA(I) 

AWV(i)  =  'N' 

CTMT  "  WNAM(IDX) 

CWNAM  =  CTMP 

IF(CWNAM(2:2).EQ. CWNAM  =  CTMP(3:12) 

IF((CNOT.EQ. '  ' . AND. CNAM.EQ. CWNAM). OR. 

+  (CNOT.EQ. 'NOT. ' .AND. CNAM.NE. CWNAM))  AWW(I)  = 

400  CONTINUE 
C 

ENDIF 

C 

C  Write  out  the  list  of  weapons  allowed... 

IF( IPRINT . NE . 0 . AND . OPR (ICO) . GE .TPl . AND . OPR ( ICO) . LE . TP2)  THEN 
WRITE (15,*) 

WRITE(15,*)  'SWOC:  Selecting  Weapon(s)  of  Choice...' 
WRITE(15,*)  '  Weapon  of  Choice  Requirement:  ', 

+  WOC (ICO, INDEX) 

WRITE (15,*)  ' . ' 

WRITE (15,*)  '  Does  weapon  meet' 

WRITE (15,*)  'Weapons  WOC  Requirement?  ' 

WRITE(15,*)  ' . ' 

DO  500  I  =  1,NSALL 

500  WRITE(15,2000)  W.NAM(IDXSA(I))  ,AWW(I) 

WRIT2(15,*)  ' . -' 

ENDIF 

C 

C  Select  a  weapon 

DO  600  I  =  l.NSALL 

IF(AWW(I).NE. 'N')  THEN 
lUSE(INDXI)  =  IDXSA(I) 

GOTO  1000 
ENDIF 
600  CONTINUE 
C 

2000  F0RMAT(1X,A10,10X,A1) 

C 

1000  RETURN 
C 


END 
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SUBROUTINE  UOUT(  150, INT,NUMSW,NUMST, INDEX,WDEC) 

C 

C  UOUT  is  a  utility  routine  to  help  make  calculations  of 
C  output  parameters  more  efficient.  It  performs  calculations 
C  across  passes  for  weapons  and  pairs... 

C  150  is  an  index  for  the  scenario  currently  being  calculated 

C  where  150  =  1  is  for  day-to-day,  delayed  launch 

C  2  is  for  day-to-day,  prompt  launch 

C  3  is  for  generatc-1,  delayed  launch 

C  4  is  for  generated,  prompt  launch 

C  INT  is  the  number  of  targets  in  an  objective  which  do  not 

C  receive  at  least  one  time  appropriate  weapon 

C  NUMSW  is  the  total  number  of  weapons  allocated,  by  time  urgency 

C  NUMST  is  the  number  of  targets  covered,  by  time  urgency 

C  INDEX  is  an  array  of  the  numbers  of  weapon  types  allocated 

C  by  time  urgency 

C  WDEC  is  the  array  of  total  DEs  achieved  as  a  result  of  weapon 
C  allocation  (by  scenario) 

C 

IMPLICIT  INTEGER*4  (I-N) 

CHARACTER*8  NAME , NAME2 

DIMENSION  NUMST (3,20), WDEC (3,20),1NDEX(3), NUMSW (3,20) 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

K  =  ICO 

IB  =  INDXdCOP.l) 

IE  =  INDX(1C0P,2) 

IF(IB.EQ.O)  GOTO  1000 
C 

DO  500  I  =  IB, IE 

C  Discount  any  null  lines... 

IF(ATNUM(I).EQ.O)  GOTO  500 

C  For  now,  skip  any  first  weapon  of  a  same  pass  pair... 

IF(WPT(I).EQ.-1)  GOTO  500 
C 

C  This  is  a  single  weapon  or  a  pair  of  the  same  weapon 

C  (either  pass) . . . 

IF((AWTYP(I,1) .EQ.O.OR.AWTYP(I,2).EQ.O).AND.WPT(I).GE.l)  THEN 
IDX  =  AWTYP(I,1) 

IF(IDX.EQ.O)  IDX  =  AWTYP(I,2) 

NAME  =  WNAM(IDX) 

IF(NAME(1:1).EQ. 'g' .AND. I50.lt. 3)  GOTO  500 
IW  =  WTU(IDX) 

INDEX(IW)  =  INDEX(IW)  +  1 
IX  =  INDEX(IW) 

NUMSW (IW, IX)  =  WPT(I)*ATNUM(I) 

NUMST ( I W, IX)  =  ATNUM(I) 


o  o  o 
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WDEC(IW,IX)  =  DEA(I,I50) 
IF(IW.GT.TUR(K))  INT  =  INT  +  ATNUM(I) 
GOTO  500 
END  IF 


Initialize  for  pairs... 

This  is  a  cross-pass  pair... 
IF(AWTYP(I,1).NE.0.AND.AWTYP(I,2).NE.0)  THEN 
IDXl  =  AWTYPd.l) 

IDX2  =  AWTYP(I,2) 

NAME  =  WNAM(IDXl) 

NAME2  =  WNAM(IDX2) 

ENDIF 

C  This  is  a  same-pass  pair  of  different  weapons... 

IF(WPT(I).EQ.-2)  THEN 

if(awtyp(i,i).eq.o)  then 

IDXl  =  AWTYP(I-1,2) 

IDX2  =  AWTYP(I,2) 

NAME  =  WNAM(IDXl) 

NAME2  =  WNAM(IDX2) 

ELSE 

IDXl  =  AWTYP(I-1,1) 

IDX2  =  AWTYP(I,1) 

NAME  -  WNAM(IDXl) 

NAME2  =  WNAM(IDX2) 

ENDIF 

ENDIF 

C 

C  For  day  cases,  discount  if  both  weapons  generated.. 

IF(NAME(1:1).EQ. 'g' .AND.NAME2(1: 1) .EQ. 'g' .AND. 

+  I50.lt. 3)  GOTO  500 

C 

C  If  only  one  is  generated,  discount  for  the  day  case 

IF(NAME(1:1).EQ. 'g' .AND. 150. LT. 3)  THEN 
IW  =  WTU(IDX2) 

INDEX(IW)  =  INDEX(IW)  +  1 
IX  =  INDEX(IW) 

NUMSW(IW,IX)  =  ATNUM(I) 

NUNSTdW.IX)  =  ATNUMd) 

CALL  SCNDE3dDX2,I50,DEX) 

WDECdW,IX)  =  DEX 

IFdW.GT.TUR(K))  INT  =  INT  +  ATNUMd) 

GOTO  500 
ENDIF 

IF(NAME2(1:1).EQ. 'g' .AND. 150. LT. 3)  THEN 
IW  =  WTUCIDXl) 

INDEXCIW)  =  I.NDEXdW)  +  1 
IX  =  INDEXdW) 

NUMSWdW.IX)  =  ATNUMd) 

NUMSTCIW.IX)  =  ATNUMd) 

CALL  SCNDE3 (IDXl, 150, DEX) 


CJ  o  o  o  o 
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WDEC(IW,IX)  =  DEX 

IF(IW.GT.TUR(K))  INT  =  INT  +  ATNUM(I) 
GOTO  500 
ENDIF 


Both  must  be  ok  in  terms  of  alert  status,  so  check  to  see 
which  weapon  has  the  higher  time  urgency  (lower  value)  and 
give  it  full  credit... the  other  weapon  gets  the  incremental 
value. . . 

IF(WTU(IDX1).LT.WTU(IDX2))  THEN 
IW  =  WTU(IDXl) 

INDEX(IW)  =  INDEX(IW)  +  1 
IX  =  INDEX(IW) 

NUMSWdW.IXj  =  ATNUM(I) 

NUMSTdW.IX)  =  ATMUMd) 

CALL  SCNDE3 (10X1,150, DEX) 

WDEC(IW,IX)  =  DEX 

IF(IW.GT.TUR(K))  INT  =  INT  +  ATNUM(I) 

IW  =  WTU(IDX2) 

INDEX(IW)  =  INDEXdW)  +  1 
IX  =  INDEXdW) 

NUMSW(IW,IX)  =  ATNUMd) 

NUMSTdW.IX)  =  ATNUM(I) 

WDECdW.IX)  =  DEA (1,150)  -  DEX 
GOTO  500 
ENDIF 

IF(WTU(IDX1).GT.WTU(IDX2))  THEN 
IW  =  WTU(IDX2) 

INDEX(IW)  =  INDEX(IW)  +  1 
IX  =  INDEX(IW) 

NUMSWdW.IX)  =  ATNUM(I) 

NUMSTdW.IX)  =  ATNUMd) 

CALL  SCNDE3(IDX2,I50,DEX) 

WDEC(IW,IX)  =  DEX 

IF(IW.GT.TUR(K))  INT  =  INT  +  ATNUM(I) 

IW  =  WTU(IDXl) 

INDEXdW)  =  INDEX(IW)  +  1 
IX  =  INDEXdW) 

NUMSWdW.IX)  =  ATNUMd) 

NUMSTdW.IX)  =  ATNUMd) 

WDECdW.IX)  =  DEA(I,I50)  -  DEX 
GOTO  500 
ENDIF 

Both  weapons  must  have  the  same  time  urgency. . . 

IW  =  WTU(IDXl) 

INDEXdW)  =  INDEX(IW)  +  1 
IX  =  INDEX (IW) 

NUMSWdW.IX)  2*ATNUM(I) 

NUMSTdW.IX)  =  ATNUMd) 

WDECdW.IX)  =  DEA(I,I50) 

IF(IW.GT.TUR(K))  INT  =  INT  +  ATNUM(I) 
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500  CONTINUE 


1000  RETURN 


END 
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SUBROUTINE  WALLC2(lDLOW,IGOON) 

C 

C  WALLC2  does  the  second  pass  weapon  allocation.  IDLOW  is  the 
C  index  of  the  target  subset  which  requires  further  allocation. 

C  IGOON  says  to  go  on  to  the  next  objective  (IG00N=1)  when  there 
C  are  no  suitable  weapons  left  or  when  the  DE  goal  has  been  met. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$  INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'AWEAPS.CDE' 

$  INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'PRINT. CDE' 

$  INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'SSPKDE.CDE' 

$  INCLUDE:  'TARGT.CDE' 

^INCLUDE:  'WEAPS.CDE' 

C 

C  Search  through  the  list  of  weapons  to  see  which  ones  meet  the 
C  Pass  2  DE  requirements... 

C 

IGOON  =  0 
C 

IF(IPRINT.NE.0.AND.0PR(IC0).GE.TP1.AND.0PR(IC0).LE.TP2)  THEN 
WRITEdS,*) 

WRITEdS,*)  'WALLC2:  Weapons  selected  are  '  .WNAMCIUSEd)) 
ENDIF 
C 

K  =  ICO 
II  =  IDLOW 
C 

C  Set  IPl:  set  to  1  if  this  allocation  subset  does  not  already 
C  have  at  least  one  weapon  allocated... 

IPl  =  0 

IF(AWTyPdDLOW,l).EQ.O.AND.AWTyPdDLOW,2).EQ.O)  IPl  =  1 
C 

C  Check  how  many  single  weapons  are  in  inventory  first... 
IFCIPl.EQ.l)  THEN 

IF(AINVdUSEd)).LT.TGOFJR(ICO))  THEN 
NWAd)  =  AINVdUSEd)) 

ELSE 

NWAd)  =  TGOFORCICO) 

ENDIF 

ELSE 

IF(AINVdUSEd)).LT.ATNUMdl))  THEN 
NVAd)  =  AINVdUSEd)) 

ELSE 

NWAd)  =  ATNUMCIl) 

ENDIF 

ENDIF 

C 


o  o 
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C  Calculate  the  number  of  weapons  required  to  meet  the  mean  DE 
C  (when  IDEP(2)=2)  and  compare  with  number  available... 

IF(IDEP(2).EQ. '2')  THEN 

CALL  WNCALC(I1,IUSE(1),NWTEST) 

IF(NWTEST.EQ.O)  THEN 
IGOON  =  1 
RETURN 
END  IF 

IF(NWTEST.LE.NWA(l).AND.NWTEST.GT.O)  NWA(l)  =  NWTEST 
ENDIF 
C 

C  If  the  new  allocation  has  enough  weapons  to  cover  the  subset, 

C  replace  the  old  NDXA  line;  otherwise  create  a  new  NDXA  line 
C  for  targets  not  yet  hit  a  second  time... 

C  Make  special  accounting  for  NOT  TARGETED  subset  of  targets... 

IF(IPl.EQ.l)  THEN 
CALL  WUNHIT(IDLOW) 

GOTO  1000 
ENDIF 
C 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
WRITE(15,*)  'WALLC2:  Number  of  Weapons  Available  for 
+  'Allocation:  ' ,AINV(IUSE(1) ) 

IF(N’WTEST.GE.ATNUM(I1))  THEN 

WRITE(15,*)  '  Number  of  Targets  needing  Second', 

+  '  Weapon:  ',ATNUM(U) 

ELSE 

IF(IDEP(2).EQ. '2') 

+  WRITE(15,*)  '  Number  of  Targets  needing  Second', 

+  '  Weapon:  ', NWTEST 

ENDIF 

WRITE(15,*)  '  Number  of  Weapons  to  be  Allocated:  ', 

+  NWA(l) 

ENDIF 

Allow  for  case  where  there  are  more  weapons  than  targets... 

IF(NWA(1) .GE.ATNUM(Il))  THEN 
C  Do  initializations  -  s^t  IP=1  for  any  pair  where  a  weapon  was 

C  allocated  in  Pass  l(all  x-pass  pairs),  IP=2  for  any  pairs  where 

C  both  weapons  are  allocated  in  Pass  1.  IX  is  the  index  that  says 

C  where  in  the  NDXA  arrays,  new  values  are  to  be  stored.  IX  is  the 

C  current  NDXA  index  for  all  x-pass  pairs  or  where  two  weapons  of  the 

C  same  type  are  allocated  as  a  pair  in  Pass  2.  IX  is  the  current  NDXA 

C  index  plus  1  for  Pass  2  pairs  where  the  second  weapon  is  different 

C  than  the  first  weapon...  WPT  is  also  reset  depending  on  whether 

C  this  is  a  same-pass  pair... 

IP  =  1 

IX  =  II 

IF(AWTYP(I1,1).EQ.0)  THEN 
IP  =  2 
WPT(Il)  =  2 


non 
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IF(AWTYP(I1,2).NE.IUSE(1))  THEN 
IX  =  II  +  1 
CALL  ABUHP(Il) 

WPT(Il)  =  -1 
WPT(IX)  =  -2 
ATNUM(I1+1)  =  ATNUM(Il) 

END  IF 
ENDIF 

DEB4  =  l.-DE(K,AWTYP(Il,IP)) 

DEAdX.ISC)  =  l.-(l.-DE(K,IUSE(l)))*DEB4 
CALL  SCNDE2 ( IX , DE (K , lUSE ( 1 ) ) , lUSE ( 1 ) , 

+  DE(K,AWTYP(I1,IP)),AWTYP(I1.IP)) 

AWTYP(IX,2)  =  lUSE(l) 

CALL  DNCALC 

DEI (IX)  =  DENEW(K) 

AINVdUSEd))  =  AINVCIUSEd))  -  ATNUMdX) 

C 

ELSE 

C 

C  Allow  for  case  where  there  are  more  targets  than  weapons... 

C  For  all  three  cases  (x-pass  pair,  pass2“pair-same-weapon, 

C  pass2-pair-dif ferent  weapon)  put  the  'leftover'  targets  into 
C  the  second  line. . . ) 

C 

CALL  ABUMPCIl) 

DO  100  J  =  1,3 

100  AWTYPCll+l.J)  =  AWTYPCIl.J) 

ATNUMCll+l)  =  ATNUMdl)  -  NWA(l) 

DO  no  J  =  1,4 

no  DEAdl+l,J)  =  DEAdi,J) 

WPTdl+1)  =  WPTCIl) 

DEIdl+1)  =  DEldl) 

Do  initializations  for  the  various  cases ...  see  note  on  IP  and 
IX  above . . . 

IP  =  1 

IX  =  II 

IF(AWTYPdl,l).EQ.O)  THEN 
IP  =  2 
WPTCIl)  =  2 

I F ( AWTYP ( 1 1 , 2 ) . NE . I USE ( 1 ) )  THEN 
IX  =  II  +  1 
CALL  ABUMPCIl) 

WPTCIl)  =  -1 
WPT(IX)  =  -2 
ATNUM(Il)  =  .\¥A(1) 

ENDIF 
ENDIF 

AWTYP(IX,2)  =  lUSE(l) 

AT.NUMCIX)  =  NWA(l) 

DEACIX.ISC)  =  l.-(l.-DE(K,IUSE(l)))*(l-DE(K,AWTYP(Il,IP))) 
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CALL  SCNDE2 ( IX , DE (K , lUSE ( 1 ) ) , lUSE ( 1 ) , 

+  DE(K,AWTYP(I1,IP)),AWTYP(I1,IP)) 

CALL  DNCALC 

DEI (IX)  =  DENEW(K) 

AINVdUSEd))  =  AINVdUSEd))  -  NWACl) 

C 

ENDIF 

C 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TPl.AND.OPRdCO).LE.TP2)  THEN 
WRlTEClS,*)  '  The  old  DE  is:  ' ,DE0LD(K) 

WRITEdS,*)  '  The  new  DE  is:  '  ,DENEW(K) 

ENDIF 

C 

1000  DEOLD(K)  =  DENEW(K) 

C 

RETURN 

C 

END 


SUBROUTINE  WALLOC(IRCAST) 

C 

C  WALLOC  allocates  as-much-as-possible  or  as-many-as-necessary 
C  of  a  selected  weapon.  If  there  are  not  enough  of  the  weapon 
C  to  meet  the  objective,  IRCAST  is  set  to  'l', 

C 

IMPLICIT  INTEGER*4(I-N) 

C 

$  INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'PRINT. CDE' 

$  INCLUDE:  'SSPKDE.CDE' 

$  INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'TARGT.CDE' 

$  INCLUDE:  ' WEARS. CDE' 

C 

IRCAST  =  0 
NWA(l)  =  0 
NWA(2)  =  0 
C 

C  Check  number  of  available  weapons... 

C 

AVI  =  AINVdUSEd)) 

IF(AVl.LT.TGOFORdCO))  THEN 
NWACl)  =  AVI 
IRCAST  =  1 
ELSE 

NWAd)  =  TGOFORdCO) 

ENDIF 

C 

C  Now  check  the  second  weapon  (if  a  pair)... 

C  Note:  This  is  a  'successful'  pair  only  if  their  are  enough  of 
C  each  member  of  the  pair  for  allocation... 

IFdUSE(2).GT.O)  THEN 
AV2  =  AINVdUSE(2)) 

IF (AV2.lt. TGOFORdCO))  THEN 
NWA(2)  =  AV2 
IRCAST  =  1 
ELSE 

NWA(2)  =  TGOFOR(ICO) 

ENDIF 

C  For  the  pair,  allocate  only  as  much  as  the  least  available... 
IF(NWA(1).EQ.NWA(2))  GO  TO  100 
1F(NWA(1).LT.NWA(2))  THEN 
NWA(2)  =  NWA(l) 

ELSE 

NVA(l)  =  N'WA(2) 

ENDIF 

C  For  pairs  of  the  same  weapon,  allocate  AMAN/AMAP  of  the  pair.. 
100  IF(IUSE(1).EQ.IUSE(2))  THEN 
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NWA(l)  =  AINV(IUSE(l))/2 
NWA(2)  =  NWA(l) 

IF(NWA(1).GT.TG0F0R(IC0))  THEN 
.%^A(1)  =  TGOFOR(ICO) 

NWA(2)  =  NWA(l) 

ENDIF 

ENDIF 

ENDIF 

C 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
WRITE (15,*) 

WRITE(15,*)  'WALLOC:  Number  of  Weapons  Available  for  Alloca', 

+  'tio.i:  '  ,AINV(IUSE(1)) 

IF(IUSE(2).GT.O)  THEN 
WRITE(15,*)  ' 

+  '  and:  ' ,AINV(IUSE(2)) 

ENDIF 

ENDIF 

C 

C  Check  the  coverage  (IDEP=2)  reqt;  if  coverage  is  not  mandatory  and  there 
C  are  enough  weapons  to  meet  the  DE  without  complete  coverage,  do 
C  not  recast  the  objective... 

IF(^DEP(l).EQ. '2')  THEN 
bETOT  =  0. 

DECOVR  =  DE(IC0,IUSE(1)) 

IF(NWA(2).NE.O)  DECOVR  =  1.-(1.-DE(IC0,IUSE(1)))* 

+  (l.-DE(IC0,IUSE(2))) 

IB  =  INDX(IC0P,1) 

IE  =  INDX(IC0P,2) 

IF(IB.NE.O)  THEN 
DO  no  I  =  IB, IE 

C  Discount  any  first  weapons  of  a  pair... 

IF(WPT(I).EQ.-1)  GOTO  110 
DETOT  =  DETOT+DEA(I,ISC)*ATNUM(I) 
no  CONTINUE 

ENDIF 

NUMREQ  =  (0DE1(IC0)*TNUM(IC0)-DET0T)/DEC0VR  +  1 
IF(NUMREQ.LT.NWA(1))  THEN 
IRCAST  =  0 
NWA(l)  =  NUMREQ 

IF(NWA(2).NE.O)  NWA(2)  =  NUMREQ 
ENDIF 

I F (I PR I NT . NE . 0 . AND . OPR ( I CO) . GE . TP 1 . AND . OPR ( ICO) . LE . TP2 )  THEN 
IF(TGOFOR(ICO).LT. NUMREQ)  THEN 

WRITE(15,*)  '  Number  Required  for  the  All', 

+  'ocation:  ' ,TG0F0R(IC0) 

ELSE 

WRITE(15,*)  '  Number  Required  to  meet  the', 

+  '  DE  or  cover  the  targets:  '.NUMREQ 

ENDIF 

WRITE(15,*)  '  Number  to  be  Allocated:  ', 


+  NWA(1)+NWA(2) 

ENDIF 
ENDIF 


RETURN 


o  o  o  o  o 
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SUBROUTINE  WCOUNT(NWEAP) 


WCOUNT  counts  the  number  of  available  weapons, 

NWEAP,  and  reconstructs  the  list  of  allowable 
weapons,  taking  out  any  where  the  inventory  is  zero, 

IMPLICIT  INTEGER*4  (I-N) 

$  INCLUDE:  'AWEAPS.CDE' 

$  INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' PRINT. CDE' 

$ INCLUDE:  ' WEARS. CDE' 

C 

NWEAP  =  0 

DO  100  IC0UNT=1,NSALL 

NWEAP  =  NWEAP  +  AINV(IDXSA(ICOUNT) ) 

100  CONTINUE 
C 

IF(IPRINT.EQ.2.AND.0PR(IC0).GE.TP1.AND.0PR(IC0).LE.TP2)  THEN 
WRITE (15,*) 

WRITE(15,*)  'WCOUNT:  Current  Weapon  Count  is  '.NWEAP 
ENDIF 

IF(NSALL.EQ.O)  GO  TO  1000 
J  =  0 

DO  200  I=1,NSALL 

IF(AINV(IDXSA(I)).LE.O)  THEN 

IF(IPRINT.EQ.2.AND.OPR(ICO).GE.TPl.AND.OPR(lCO).LE.TP2) 
+  WRITEdS,*)  '  Weapon(s)  Depleted  -  ', 

+  WNAMCIDXSAd)) 

GO  TO  200 
ENDIF 
J  =  J+1 

IDXSA(J)  =  IDXSA(I) 

200  CONTINUE 
NSALL  =  J  ■ 

C 

1000  RETURN 
C 


END 


o  o  o  o  o  o  o 
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SUBROUTINE  WINVNT 

C 

C  WINVNT  calculates  the  inventories  of  weapons.  This 
C  accounts  for  losses  and  alert  rates. 

C 

IMPLICIT  INTEGERS  (I-N) 

CHARACTER* 10  NEWNAM 
C 

$ INCLUDE:  'AWEAPS.CDE' 

$  INCLUDE:  'WEAPS.CDE' 

$  INCLUDE:  ' PRINT. CDE' 

$  INCLUDE:  'RULES. CDE' 

C 

DIMENSION  INVAL(60) , INVWL(60) , INVNS (60) , INVRL(60) 


Calculate  the  total  inventory... 

NMAX2  =  NMAX/2 

I F ( NWTYP . GT . NMAX2 . AND . AORDER . EQ . ' 1 ' )  THEN 

WRITE(15,*)  'WINVNT:  Error  in  Input.  Too  many  Weapons 
WRITE (15,*)  'FALCON  STOPPING’ 

WRITE(*,*)  'WINVNT:  Error  in  Input.  Too  many  Weapons  - 
WRITE (*,*)  'FALCON  STOPPING' 

STOP 
ENDIF 

DO  100  1=1, NWTYP 
AINV(I)  =  mil) 

100  CONTINUE 

Account  for  availability  losses... 

DO  no  1=1,  NWTYP 

AINVAL(I)  =  NW(I)  -  NW(I)*WAV(I) 

INVAL(I)  =  AINVAL(I)  +0.5 
AINV(I)  =  NW(I)  -  INVAL(I) 

C  Take  out  any  specified  withold... 

AINVWL(I)  =  NWTH(I)  +  (AINV(I)-NWTH(I))*PWTH(I) 

INVW'L(I)  =  AINVW'L(I)  +  0.5 

AINV(I)  =  NW(I)  -  INVAL(I)  -  INVWL(I) 

C  Take  out  any  weapons  which  are  not  surviving. . . 

IFdPLS.EQ.  'l')  THEN 

AINVNS(I)  =  AINV(I)*(1.-PLS(I)) 

INVNS(I)  =  AINVNS(I)  +0.5 
PLS(I)  =  1.0 

AINV(I)  =  NW(I)  -  INVAL(I)  -  INVWL(I)  -  INVNS(I) 
ENDIF 
no  CONTINUE 
C 

C  Print  out  these  inventories... 

CALL  WINVO 


u  o  o 
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Account  for  alert  rates,  either  generated  or  day-to-day... 

IF ( ARATE . EQ . ' G ' . AND . AORDER . EQ . ' 2 ' )  THEN 
DO  130  I=l,N\s’TYP 

AINVRL(I)  =  AINV(I)*(1.-  WAG(I)) 

INVRL(I)  =  AINVRL(I)  +0.5 

AINV(I)  =  NW(I)-INVAL(I)-INVWL(I)-INVRL(I) 

IF(IPLS.EQ.'l') 

+  AINV(I)  =  NW(I)-INVAL(I)-INVWL(I)-INVRL(I)-INVNS(I) 

130  CONTINUE 

ELSE  IF ( ARATE. EQ. 'D')  THEN 
DO  140  I=1,NWTYP 

AINVRL(I)  =  AINV(I)*(1.-  WAD(I)) 

INVRL(I)  =  AINVRL(I)  +  0.5 

AINV(I)  =  NW(I)  -  INVAL(I)  -  INVWL(I)  -  INVRL(I) 
IFCIPLS.EQ. '!') 

+  AINV(I)  =  NW(I)-INVAL(I)-INVWL(I)-INVRL(I)-INVNS(I) 

140  CONTINUE 

ELSE 

DO  145  I=1.NWTYP 
J  =  NWTYP  +  I 
WPR(J)  =  WPR(I)  +  WPMAX 
WAV(J)  =  WAV(I) 

DO  150  1145  =  1,4 

PLSS(J,I145)  =  PLSS(I,I145) 

PTPS(J,I145)  =  PTPS(I,I145) 

150  CO.NTINUE 

PLS(J)  =  PLS(I) 

PTP(J)  =  PTP(I) 

WAG(J)  =  WAG(I) 

WAD(J)  =  WAD(I) 

RELL(J)  =  RELL(I) 

RELI(J)  =  RELI(I) 

RELW(J)  =  RELW(I) 

WTU(J)  =  WTU(I) 

YLD(J)  =  YLD(I) 

CEP(J)  =  CEP(I) 

AINVS  =  NW(I) 

NW(I)  =  AINVS*WAD(I)+0.5 
NW(J)  =  AINVS  -  NU'CI) 

AINVAL(J)  =  0 
AR  =  WAG(I) 

IFCARATE.EQ. 'D')  AR  =  WAD(I) 

AINVRL(I)  =  AI.NV(I)*(i.-AR) 

INVRL(I)  =  AINVRL(I)  +  0.5 
AI.NVRL(J)  =  0 
INVRL(J)  =  0 
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AINVS  =  AINV(I) 

AINVCI)  =  AINVS*WAD(I)  +0.5 
AINV(J)  =  (AINVS*WAG(J))  -  AINV(I)  +0.5 
C 

NEWNAM(3:10)  =  WNAM(I) 

NEWNAM(1:2)  =  'd_’ 

WNAM(I)  =  NEWNAM 
NEWNAM(1:2)  =  ’g.' 

WNAM(J)  =  NEWNAM 
WCAT(J)  =  WCAT(I) 

WLEG(J)  =  WLEG(I) 

MOBW(J)  =  MOBW(I) 

NWTH(J)  =  0. 

PWTH(J)  =  0. 

145  CONTINUE 

WPMAX  =  WPMAX*2 
NWTYP  =  NWTYP*2 
C 

ENDIF 

C 

IF(IPRINT.GE.2)  THEN 
WRITE (15,*) 

WRITE(15,*)  'WINVNT:  Calculating  the  Total  Inventory  ' 
WRITE (15,*) 

IFdPLS.EQ. '!')  THEN 

WRITE (15,*)  '  De-  With  Not  ’, 

+  '  Not  Alio-  ' 

WRITE(15,*)  'Weapon  ployed  Avail  held  Alert  ', 
+  'Surviving  eatable' 

WHITE (15,*)  ' . ', 

' _ » 


DO  180  1=1, NWTYP 

WRITE(15,2000)  WNAM(I) ,NW(I) ,INVAL(I) ,INVWL(I) , 

+  INVRL(I),INVNS(I),AINV(I) 

180  CONTINUE 

ELSE 

WRITE(15,*)  'Weapon  Deployed  Avail  Withheld  ', 
+  'Alert  Allocatable' 

WRITE (15.*)  ' . ', 

i  ' _ I 


DO  185  I=l,f3s'TYP 

WRITE(15,2010)  WNAM(I),NW(I),INVAL(I),INVWL(I), 
+  INVRL(I),AINV(I) 

185  CONTINUE 

ENDIF 
ENDIF 
C 

C  Initialize  the  IDXSA  array... and  store  the  initial 
C  inventory  of  all  weapons... 

NSALL  =  NWTYP 
DO  190  I  =  1, NSALL 
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IDXSA(I)  =  I 
.  AINVT(I)  =  AINV(I) 

190  CONTINUE 
C 

2000  FORMAT(1X,A10,1X,I5,4(2X,I5),4X,I5) 
2010  FORMAT(1X,A10.2X,I6,3(1X,I7),2X,I6) 
C 


C 


RETURN 

END 


SUBROUTINE  WINVO 


c 

C  WINVO  displays  the  inventory  of  weapons  and  accounts  for 
C  losses  due  to  availability,  withold  and  other  factors. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

CHARACTER* 11  TITLE 
CHARACTER*!  NAME (3) 

INTEGER*2  LU 
DIMENSION  IT0TS(4,13) 

C 

C  Note:  in  the  ITOTS  array,  the  first  subscript  refers  to: 

C  1  -  ICs,  2  -  SLs,  3  -  AIR,  4  -  Total 

C  and  the  second  subscript  refers  to  the  category  being  calculated: 
C  1  “  Inventory,  2  -  Available,  3  -  SIOP  Available,  etc. 

C 

$  INCLUDE:  'WEAPS.CDE' 

DATA  NAME/'I','S','A'/ 

C 

LU  =  16 

WRITE(LU,2990) 

WRITE  (LU,  3020)  ’  ************************»ir***A******>'riV**Vf ** '  ^ 

+  '  INVENTORY  OF  WEAPONS  BY  WEAPON  STATUS  ***', 

+  '  ****************************  AVfVf>V*>V*>ViV ' 

WRITE (LU, 3020)  '|  ', 

+  '  DAY-TO-DAY  ALERT  ' , 

+  '  GENERATED  ALERT  | ' 

WRITE(LU,3020)  '|  ', 

'  _  < 


WRITE (LU  3020)  '|  SIOP  ', 

+  '  DAY  SURVIVING  ARRIVING 

+  '  GEN  SURVIVING  ARRIVING  | ' 

WRITE (LU, 3020)  ' | WEAPON  DEPLOYED  AVAIL  AVAIL  ', 

+  '  ALERT  DEL  PRL  DEL  PRL 

+  '  ALERT  DEL  PRL  DEL  PRL  |  ' 

WRITE (LU, 3020)  '| . ', 

_L  ' _ ' 


C 

DO  50  J=l,4 
DO  50  K  =  1,13 
ITOTS (J,K)  =  0 
50  CONTINUE 
C 

DO  no  IT=1,3 
DO  100  J  =  l.WPMAX 
DO  100  I=1,NWTYP 

IF(WPR(I).NE.J)  GOTO  100 
IF(WLEG(I).NE.NAME(IT))  GO  TO  100 
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Calculate  the  total  inventory 
IT0TS(IT,1)  =  IT0TS(IT,1)  +  NW(I) 
IT0TS(4,1)  =  IT0TS(4,1)  +  NW(I) 

Next  take  out  for  availability  losses 
AVAIL  =  NW(I)*WAV(I) 

IVAIL  =  AVAIL  +0.5 
IT0TS(IT,2)  =  IT0TS(IT,2)  +  IVAIL 
IT0TS(4,2)  =  IT0TS(4,2)  +  IVAIL 
Take  out  any  specified  witholds... 
Slop  =  (AVAIL-NWTH(I))*(1.-PWTH(I)) 
ISIOP  =  Slop  +0.5 
IT0TS(IT,3)  =  1T0TS(IT,3)  +  ISIOP 
IT0TS(4,3)  -■=  IT0TS(4,3)  +  ISIOP 


Calculate  the  weapons  on  day-to-day  alert 
DAY  =  SI0P*WAD(I) 

IDAY  =  DAY  +  0.5 

IT0TS(IT,4)  =  IT0TS(IT,4)  +  IDAY 
IT0TS(4,4)  =  IT0TS(4,4)  +  IDAY 

Calculate  the  surviving  weapons  on  day-to-day  alert  -  del  case 
SDAYR  =  DAY*PLSS(I,1) 

ISDAYR  =  SDAYR  +0.5 
IT0TS(IT,5)  =  IT0TS(IT,5)  +  ISDAYR 
IT0TS(4,5)  =  IT0TS(4,5)  +  ISDAYR 

Calculate  the  surviving  weapons  on  day-to-day  alert  -  prl  case 
SDAYL  =  DAY*PLSS(I,2) 

ISDAYL  =  SDAYL  +0.5 
IT0TS(IT,6)  =  IT0TS(IT,6)  +  ISDAYL 
IT0TS(4,6)  =  IT0TS(4,6)  +  ISDAYL 

Calculate  the  arriving  weapons  on  day-to-day  alert  -  del  case 

ADAYR  =  SDAYR*RELL(I)*RELia)*RELW(I)*PTPS(I,l) 

lADAYR  =  ADAYR  +0.5 

IT0TS(IT,7)  =  IT0TS(IT,7)  +  I ADAYR 

ITOTS(4,7)  =  IT0TS(4,7)  +  lADAYR 

Calculate  the  arriving  weapons  on  day-to-day  alert  -  prl  case 

ADAYL  =  SDAYL*RELL(I)*RELI(I)*RELW(I)*PTPS(I,2) 

lADAYL  =  ADAYL  +0.5 

IT0TS(IT,8)  =  IT0TS(IT,8)  +  lADAYL 

1T0TS(4,8)  =  IT0TS(4,8)  +  lADAYL 


Calculate  the  weapons  on  generated  alert 
GEN  =  SI0P*WAG(I) 

IGEN  =  GEN  +  0.5 

IT0TS(IT,9)  =  IT0TS(IT,9)  +  IGEN 
IT0TS(4,9)  =  IT0TS(4,9)  +  IGEN 

Calculate  the  surviving  weapons  on  generated  alert  -  del  case 
SGENR  =  GEN*PLSS(I,3) 

ISGENR  =  SGENR  +0.5 

ITOTS(IT,10)  =  IT0TS(IT,10)  +  ISGENR 

IT0TS(4,10)  =  IT0TS(4,10)  +  ISGENR 

Calculate  the  surviving  weapons  on  generated  alert  -  prl  case 
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SGENL  =  GEN*PLSS(I,4) 

ISGENL  =  SGENL  +0.5 

ITOTS(IT,ll)  =  ITOTS(IT,l])  +  ISGENL 

IT0TS(4,11)  =  IT0TS(4,11)  +  ISGENL 

C  Calculate  the  arriving  weapons  on  generated  alert  -  del  case 

AGENR  =  SGENR*RELL(I)*RELI(I)*RELW(I)*PTPS(I,3) 
lAGENR  =  AGENR  +0.5 
IT0TS(IT,12)  =  IT0TS(IT,12)  +  lAGENR 
IT0TS(4,12)  =  IT0TS(4,12)  +  lAGENR 

C  Calculate  the  arriving  weapons  on  generated  alert  -  prl  case 

AGENL  =  SGENL*RELL(I)*RELI(I)*RELW(I)*PTPS(I,4) 
lAGENL  =  AGENL  +0.5 
IT0TS(IT,13)  =  IT0TS(IT,13)  +  lAGENL 
IT0TS(4,13)  =  IT0TS(4,13)  +  lAGENL 
C 

WRITE(LU,3010)  '  | '  ,WNAM(I)  ,NW(I) ,  IVAILJSIOP,  IDAy,ISDAYR, 

+  ISDAYL,IADAYR,IADAYL,IGEN,ISGENR,ISGENL,IAGENR,IAGENL,' ! ' 

C 

100  CONTINUE 
C 

C  Write  out  the  summary  of  each  weapon  category. . . 

WRITE(LU,3022) 

C 

IF(IT.EQ.l)  THEN 

TITLE  =  'TOTAL  I CBM  ’ 

WRITE (LU, 3000)  ' | ' .TITLE, (IT0TS(IT,K) ,K-1, 13) ,' | ' 

WRITE (LU, 3020)  'j . 

-1.  ' _ • 


END  IF 

IF(IT.EQ.2)  THEN 

TITLE  =  'TOTAL  SLBM  ' 

WRITE(LU,3000)  ' | ' .TITLE, (ITOTS(IT,K) ,K=1, 13) , ' | ' 
WRITE(LU,3020)  '| . 

t 


END  IF 

IF(IT.EQ.3)  THEN 

TITLE  =  'TOTAL  AIR  ' 

WRITEILU.SOOO)  ' | ' .TITLE, (ITOTS(IT,K) ,K=1, 13) , ' 1 ' 
ENDIF 
C 

no  CONTINUE 


WRITE(LU,3020)  ’ 


TITLE  =  'ALL  WEAPONS' 

WRITE(LU,3000)  ' | ' .TITLE ,( IT0TS(4 ,K) ,K=1 . 13) .' | ' 
wK  1 1 L  C  LU ,  2  0 ;  * . *  ••  '*  •'  . . .  •' 
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'>Wf*Vf***Vr***VfA*********A?V*5':**V«V?ViV**Vf** ' 


C 

2990  FORMAT  (///) 

3000  F0RMAT(3X,A1,A11,6X,I6,2(2X,I6),2(4X,5C1X,I6)),2X,A1) 
3010  F0RMAT(3X,A1,A11,7X,I5,2(2X,I6),2(4X,5(1X,I6)),2X,A1) 
3020  F0RMAT(3X,A42,A42,A37) 

3022  FORMAT(3X,'r,119X,’r) 

C 

RETURN 

C 

END 


SUBROUTINE  WNCALCCM, !W,NWTEST) 

c 

C  Calculates  the  total  number  of  weapons  needed  to  just 
C  meet  this  DE  requirement.  II  is  the  index  for  the  current 
C  allocation;  IW  is  an  index  for  the  current  weapon,  and 
C  NWTEST  is  the  calculated  number  of  weapons  to  be  used. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$  INCLUDE:  'TARGT.CDE' 

C 

K  =  ICO 
DETOT  =  0. 

IB  =  INDX(IC0P,1) 

:E  =  INDX(IC0P.2) 

IF(J3.NE.O)  THEN 
DO  100  I  =  IB, IE 

C  Discount  any  first  weapons  of  a  pair... 

IF(WPT(I).EQ.-1)  GOTO  100 

DETOT  =  DETOT  +  DEA(I,ISC)*ATNUM(I) 

100  CONTINUE 
ENDIF 
C 

DEK  =  0. 

1F(AWTYP(I1,1).EQ.0)  THEN 

C  Account  for  targets  NOT  TARGETED  in  Pass  1... 

IF(AWTYP(I1,2).NE.0)  DEK  =  DE(K,AWTYP(I1,2)) 

ELSE 

DEK  =  DE(K,AWTYP(I1,1)) 

ENDIF 

C 

DETEST  =  (l.-(l. -DECK, IW))*(1. -DEK))  -  DEK 
NWTEST  =  0 

IF (DETEST. NE.O)  NWTEST  =  (0DE1(K)*TNUM(K)-DET0T)/DETEST  +  1 
C 

IFCIPRINT. NE.O. AND. OPR(ICO).GE.TPl. AND. 0PR(IC0).LE.TP2)  THEN 
WRITE (15,*) 

WRITE(15,*)  'WNCALC:  Additional  DE  achieved  ' 

WRITEdS,*)  '  by  this  weapon:  ', DETEST 

WRITE(15,*)  '  Weapons  needed:  '  ,N’WTEST 

WRITEdS,*) 

ENDIF 

C 

RETURN 

C 
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SUBROUTINE  WRHOB(LU,HOBW) 

c 

C  WRHOB  writes  the  HOB  values  of  weapons  by  targets  to 
C  the  logical  unit  (LU)  specified.  If  weapons  are 
C  distinguished  by  alert  rate,  print  the  HOB  for  the 
C  weapon  group  only. 

C 

C 

IMPLICIT  INTEGERS  (I-N) 

C 

CHARACTER* 1 1  WNAM2 ( 60 ) , WTEMP , WTEMP2 
C 

$ INCLUDE:  'OBJ.CDE' 

$  INCLUDE:  'PRIO.CDE' 

$ INCLUDE:  ' RULES. CDE' 

$  INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  HOBW(100,60) 

C 

IWTYP  =  NWTYP 

IF(AORDER.EQ. 'I'.AND.ARATE.EQ.'G')  IWTYP  =  NWTYP/2 
C 

DO  20  I  =  1, IWTYP 
WTEMP  =  ' 

IF ( AORDER . EQ . ' r . AND . ARATE . EQ . ' G ' )  THEN 
WTEMP2  -  WNAM(I) 

WTEMP(2:11)  =  WTEMP2(3:11) 

ELSE 

WTEMP(2:11)  =  WNAM(I) 

END  IF 

IF(H0B(I).EQ.-1)  WTEMP(1:1)  =  '*’ 

WNAM2(I)  =  WTEMP 
20  CONTINUE 
C 

ITER  =  1 

IF ( IWTYP. GT. 10)  ITER  =  IWTYP/10  +  1 
C 

WRITE (LU, 2020) 

WRITECLU,*)  'HOB  VALUES  (in  feet) 

WRITE(LU,*) 

DO  50  I  =  1,ITER 
IF(I.GT.l)  THEN 
WRITE (LU,*) 

WRITE(LU,*)  'Table  Continued. . . ' 

WRITE(LU,*) 

END  IF 

ISTART  =  (I-l)*10  +  1 

I END  =  ISTART  +  9 

IF ( ISTART. GT. IWTYP)  GO  TO  50 
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IF(IEND.GT.IWTYP)  lEND  =  IWTYP 
WRITE(LU,2010)  (WNAM2(J) , J=ISTART, lEND) 

WR ITE  ( LU ,  20 1 0 )  ( ' . ' ,  J=I  START ,  lEND ) 

DO  100  KK=l,NOBJ 
K  =  IPRIO(KK) 

WRITE (LU, 2000)  TOBJ(K) , (HOBW(K, J) , J=ISTART, lEND) 
100  CONTINUE 
C 

50  CONTINUE 

WRITE(LU,*)  '*  -  Optimum  HOB  has  been  calculated  ' 

C 

2000  F0RMAT(A12,1X,10(5X,F6.0)) 

2010  FORMAT(19X.10(A10,1X)) 

2020  FORMAT(///) 

C 

RETURN 

C 

END 


o  o  o  o 


SUBROUTINE  WRITOD(LU) 


WRITOD  writes  all  rules  to  the  audit  trail.  LU  is  the 
logical  unit  to  which  output  is  sent. 

IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  'OBJ.CDE' 

$INCLUDE:  'PRINT. CDE' 

$INCLUDE:  'PRIO.CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

C 

WRITE (LU, 3003) 

WRITE(LU,3001)  'Input  Selection  and  Program  Flow  Rules:  ' 
IFCARATE.EQ. 'G')  WRITE(Lr,*)  '  Generated  alert  rate' 

IF(ARATE.EQ. 'D')  WRITE(lU,*)  '  Day-to-Day  alert  rate' 
IF(AORDER.EQ. '1')  THEN 
WRxrECLU,*) 

+  '  Weapons  are  distingished  by  alert  status' 

ENDIF 

IF ( AORDER . EQ . ' 2 ' . OR . ARATE . EQ . ’ D ' )  THEN 
WRITE (LU,*) 

+  '  Weapons  are  not  distingished  by  alert  status' 

ENDIF 

IF(CASE.EQ.'P')  WRITE (LU,*)  '  Prompt  launch' 

IF(CASE.EQ.'d')  WRITE(LU,*)  '  Delayed  launch' 

IFdSSPK.EQ. '1')  WRITE(LU,*) 

+  '  User-input  SSPK  table  is  used' 

IFdSSPK.EQ. '2')  WRITE(LU,*) 

+  '  SSPK  is  calculaved  by  formula  ' 

IFdSSPK.EQ. '3')  WRITE(LU,*) 

+  '  PDCALC  is  used  to  generate  SSPK  table' 

IFdSSPK.EQ. '4')  WRITE  (LU,*) 

+  '  Some  SSPKs  are  input,  some  calculated  by  formula 

IFdSSPK.EQ. '5')  WRITE(LU,*) 

■H  '  Some  SSPKs  are  input,  PDCALC  generates  others  ' 

IFdPLS.EQ. '1')  WRITE(LU,*) 

+  '  PLS  is  used  to  reduce  the  number  of  allocatable' , 

+  '  weapons' 

IFdPLS.EQ. '2')  WRITE(LU,*) 

+  '  PLS  is  used  to  reduce  DE' 

IF(IPRINT.EQ.O)  WRITEfLU,*)  '  No  Diagnostic  Print' 

ir(IPRINT.EQ.l)  WRITE(LU,*) 

+  '  Limited  diagnostic  print' 

IF(IPRINT.EQ.2)  WRITE(LU,*) 

+  '  Full  diagnostic  print' 

IF(IPRCRX.EQ.l)  WRITE(LU,*)  '  Results  will  be', 

+  '  printed  for  the  allocation  scenario  only' 

IF(IPRCRX.EQ.2)  WRITE(LU,*) 

+  '  Results  will  be  printed  for  all  scenarios' 


-  287  - 


IF (TP 1 . EQ . 1 . AND . TP2 . GE . NOB J )  THEN 

WRITE(LU,*)  '  Audit  trail  will  be  printed  for  all', 

+  '  target  objectives' 

ELSE 

WRITE(LU,3050)  'Audit  trail  will  be  printed  for  target  ', 

+  'objectives' ,TP1, '  through', TP2 

ENDIF 
C 

100  WRITECLU,*) 

WRITECLU,*)  'Allocation  Rules:  ' 

DO  200  I  =  1,2 
WRITECLU,*) 

WRITECLU, 3000)  '  In  Pass', I 
IF(I.EQ.l)  THEN 

IFCARWOC.EQ. '1')  WRITECLU,*) 

+  '  Do  not  allow  relaxation  of  weapon  of  choice  ', 

+  ' requirement ' 

IFCARWOC.EQ. '2')  WRITECLU,*) 

+  '  Allow  relaxation  of  weapon  of  choice  requirement' 

IFCTSORT.EQ. '1')  WRITECLU,*) 

+  '  Weapons  which  exceed  the  timing  requirement  ' , 

+  'may  be  used' 

IFCTSORT.EQ. '2')  WRITECLU, 3040) 

+  '  Weapons  which  EXACTLY  meet  the  timing  requirement  a', 

+  're  preferred  to  weapons  which  exceed  it  ' 

ELSE 

IF(IPASS2.EQ. '1')  WRITECLU,*) 

+  '  Turn  off  Pass  2  allocations' 

IF(IPASS2.EQ. '2')  THEN 

WRITECLU,*)  '  Pass  2  allocation  will  be  conducted  ' 

IF(TLSORT.EQ.'l')  WRITECLU,*) 

+  '  Sort  the  weapons  by  timing' 

IF(TLS0RT.EQ.'2')  WRITECLU,*) 

+  '  Do  not  sort  weapons  by  timing  or  triad  leg' 

IFCTLSORT.EQ. '3')  WRITECLU,*) 

+  '  Sort  the  weapons  by  triad  leg' 

IFCARLEG.EQ. 'I'.AND.TLSORT.EQ. '3')  WRITECLU, 3040) 

+  '  Do  not  allow  the  second  weapon  to  be  from  the  same  ' , 

+  'Triad  leg  as  the  first  weapon  ' 

IFCARLEG.EQ. '2' . AND . TLSORT . EQ . '3')  WRITECLU, 3040) 

+  '  Allow  the  second  weapon  to  be  from  the  same  Triad  l', 

+  'eg  as  the  first  weapon  ' 

IFCARSAM.EQ. '1' .AND.TLSORT.EQ. '3')  WRITECLU,*) 

+  '  Do  not  allow  second  weapon  to  be  the  same  ', 

+  'weapon  as  the  first  weapon  ' 

IFCARSAM.EQ. '2' .AND.TLSORT.EQ. '3' )  WRITECLU,*) 

+  '  Allow  the  second  weapon  to  be  the  same  ' , 

+  'weapon  as  the  first  weapon  ' 

ENDIF 

ENDIF 

IF(P2(I,1).EQ. '1')  THEN 
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WRITE (LU, 3045) 

+  '  Order  weapons  which  meet  the  DE  goal  from  lowest  DE', 

+  '  to  highest  DE;  order  other  weapons  from  hi', 

+  'ghest  DE  to  lowest  DE  ' 

ELSE 

WRITE (LU, 3045) 

+  '  Order  weapons  which  meet  the  DE  goal  in  priority  or', 

+  'der;  then  order  weapons  which  do  not  meet  t', 

+  'he  DE  goal  in  priority  order  ' 

ENDIF 

IF(IDEP(I).EQ. '1')  THEN 
WRITE (LU, 3040) 

+  '  The  DE  goal  is  to  Le  met  by  each  target  in  the  targ' , 

+  'et  objective  ' 

ELSE 

WRITE (LU, 3040) 

+  '  The  DE  goal  is  to  be  met  as  a  mean  DE  for  the  entir', 

+  'e  target  objective  ' 

ENDIF 

IF(P2(I.4).EQ.'l')  THEN 
WRITE(LU,3040) 

+  '  Do  not  allow  mobile-capable  weapons  to  be  used  agai', 

+  'nst  fixed  targets  ' 

ELSE 

WRITE (LU, 3040) 

+  '  Allow  mobile-capable  weapons  to  be  used  against  fix', 

+  'ed  targets  ' 

ENDIF 

IF(P2(I,5).EQ. '1')  THEN 
WRITE(LU,3040) 

+  '  Do  not  allow  non-mobile-capable  weapons  to  be  used  ', 

+  'against  mobile  targets  ' 

ELSE 

WRITE(LU,3040) 

+  '  Allow  non-mobile-capable  weapons  to  be  used  against', 

+  '  mobile  targets  ' 

ENDIF 

IF(P2(I,2).EQ. '1')  WRITE(LU,*) 

+  '  Do  not  allow  relaxation  of  timing  requirement' 

IF(P2(I,2).EQ. '2')  WRITE(LU,*) 

+  '  Allow  relaxation  of  timing  requirement' 

IF(P2(I,3).EQ. '1')  WRITE(LU,*) 

+  '  Do  not  allow  relaxation  of  the  DE  ', 

+  'requirement' 

IF(P2(I,3).EQ. '2')  WRITE(LU,*) 

+  '  Allow  relaxation  of  DE  requirement' 

200  CONTINUE 
C 

3000  F0RMAT(A11.1X,I1) 

3001  FORMAT(A40) 

3003  F0RMAT(///) 
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3004  F0FMAT(A6,2X,A80) 

3040  F0RMAT(1X,A57,A45) 

3045  F0RMAT(1X,A57,A43,A28) 

3050  FORMAT(7X,A39.A10,I3,A8,I3) 
RETURN 
C 

END 


o  o  o  o  o 
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SUBROUTINE  WRSSPK(LU) 

WRSSPK  writes  the  SSPK/DE  values  of  weapons  by  targets  to 
the  logical  unit  (LU)  specified.  If  weapons  are  distinguished 
by  alert  rate,  print  the  SSPK  for  the  weapon  group  only. 

IMPLICIT  INTEGER*4  (I-N) 

CHARACTER*!!  WNAM2(60) ,WTEMP,WTEHP2 
C 

$ INCLUDE;  'OBJ.CDE' 

$ INCLUDE:  'PRIO.CDE* 

$ INCLUDE;  ' RULES. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$INCLVDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

IWTYP  =  NWTYP 

IF(A0RDER.EQ.'1'.AND.ARATE.EQ.*G')  IWTYP  =  NWTYP/2 
DO  20  I  =  1, IWTYP 

WTEMP  =  '  ' 

IF ( AORDER . EQ . ' 1 ' . and . ARATE . EQ . ' G ' )  THEN 
WTEMP2  =  WNAM(I) 

WTEMP  =  WTEMP2(3:U) 

ELSE 

WTEMP  =  WNAM(I) 

ENDIF 

WNAM2(I)  =  WTEMP 
20  CONTINUE 
C 

IF(LU.NE.17)  THEN 
C 

ITER  =  1 

IF(IWTYP.GT.IO)  ITER  ^  IWTYP/10  +  1 
C 

DO  50  I  =  l.ITER 
IF(I.GT.l)  THEN 
WRITE(LU,*) 

WRITE(LU,*)  'Table  Continued...' 

ENDIF 

ISTART  =  (I-l)*10  +  1 
I END  =  ISTART  +  9 
IF (I START. GT. IWTYP)  GO  TO  50 
IF (lEND.GT. IWTYP)  lEND  =  IWTYP 
WRITE(LU,2010)  (WNAM2(J) ,J=I START, lEND) 

WRITE(LU,2010)  (' . '  ,J=I START, lEND) 

DO  100  KK=l,NOBJ 
K  =  IPRIO(KK) 

WRITE ( LU , 2000 )  TOB J (K) , (DE (K , J ) , J=ISTART , lEND ) 

100  CONTINUE 
C 
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50  CONTINUE 

C 

ELSE 

WRITE(LU,2030)  (WNAM2(J) ,J=1,IWTYP) 

DO  150  K1  =  l.NOBJ 
K  =  IPRIO(Kl) 

WRITE (LU, 2040)  TOBJ(K) , (DE(K,J) , J=1,IWTYP) 
150  CONTINUE 

ENDIF 
C 

2000  F0RMAT(A12,10(6X,F5.3)) 

2010  F0RMAT(19X,10(A10,1X)) 

2030  F0RMAT(19X,40(A10,1X)) 

2040  F0RMAT(A12,40(6X,F5.3)) 

C 

RETURN 

C 

END 


SUBROUTINE  WSELCT 


C 

C  WSELCT  selects  the  single  weapon  to  be  allocated  which  meets 
C  as  many  of  the  requirements  as  possible.  The  flag  ICONT  is  set 
C  according  to  the  following  outcomes: 

C  ICONT  =  0  -  no  weapons  were  found  which  meet  the  requirements 

C  ICONT  =  1  -  A  weapon  was  found  which  meets  the  requirements  (some 

C  may  have  been  relaxed),  continue  with  weapon  selection. 

C 

IMPLICIT  INTEGERS  (I-N) 

C 

$INCLUL£:  'AWEAPS.CDE' 

§ INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' PRINT. CDE' 

$  INCLUDE:  'RULES. CDE' 

$ INCLUDE:  ' WE APS. CDE' 

C 

lUSE(l)  =  0 
IUSE(2)  =  0 
ICONT  =  0 
C 

DO  100  I  =  l.NSALL 

IF(AWX(I).EQ. 'Y')  THEN 
lUSE(l)  =  IDXSA(I) 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2) 

+  THEN 

WRITEdS,*) 

WRITE(15,*)  'WSELCT:  Weapon  selected  for  allocation', 

+  '  is:  ' ,WNAM(IUSE(1)) 

ENDIF 
ICONT  =  1 
GOTO  1000 
ENDIF 
100  CONTINUE 
C 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
WRITEdS,*) 

WRITEClS,*)  'WSELCT:  No  weapons  meet  all  requirements.' 

WRITE(15,*)  '  Returning  to  work  on  next  objective.' 

ENDIF 

C 

1000  RETURN 
C 
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SUBROUTINE  WSORT 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


WSORT  sorts  all  available  weapons  by: 

Mobility  -  for  mobile  targets,  mobile  capable 

weapons  are  sorted  before  non-mobile  ones; 
for  non-mobile  targets,  the  reverse  is  true. 

Time  Urgency  -  for  TU  targets  weapons  are  sorted  as 
time  urgent,  time  sensitive,  non-time 
sensitive;  for  time  sensitive  targets 
weapons  are  sorted  as  time  sensitive, 
time  urgent  and  non-time  sensitive;  and 
for  non-time  sensitive  targets,  weapons 
are  sorted  as  non-time-sensitive,  time 
sensitive  and  time  urgent. 

Alert  rate  -  If  weapons  are  distinquished  as  day  or  generated, 
day  weapons  are  ordered  first.  If  no  distinction 
is  made,  no  unique  ordering  by  alert  rate  is  made. 

DE  Requirement  -  weapons  which  meet  the  current  target  objective 
DE  are  ordered  before  those  which  do  not. 

Priority  -  weapons  are  finally  sorted  by  priority. 

IMPLICIT  INTEGER*4(I-N) 


CHARACTER*2  CTUR(3) 

$ INCLUDE:  'AWEAPS.CDE' 

$  INCLUDE:  'OBJ.CDE' 

$  INCLUDE:  ' PRINT. CDE' 

$  INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$  INCLUDE:  'TARGT.CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

DATA  CTUR  /'TU' , 'TS' , 'NT'/ 

C 

C  Sort  the  weapons  by  mobility. . . 
CALL  WSORTM 


C 

C  Sort  the  mobility-sorted  weapons  by  time  urgency... 

CALL  WSORTT(l) 

C 

C  Sort  the  mobility-  and  time-sorted  weapons  by  alert  rate... 
CALL  WSORTA 


C 

C  Sort  the  mobility-,  time-  and  alert-sorted  weapons  by  DE... 
CALL  WSORTD 


C 

C  Sort  the  mobility-,  time-,  alert-  and  DE-sorted  weapons  by  priority; 
C  If  final  priority  is  by  DE,  call  WSPRDE  (P0RDER=1).  If  priority  is 
C  by  user  input  priority,  call  WSORTP  (P0RDER=2). 

IF(PORDER.EQ. '1')  CALL  WSPRDE 
IFCPORDER.EQ. '2')  CALL  WSORTP 
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C 

C  Write  all  this  stuff  out... (I  is  the  mobility  loop,  J  is  the  time 
C  urgency  loop,  K  is  the  alert  rate  loop  and  L  is  the  DE  loop...) 

I F ( I PR I NT . NE . 0 . AND . OPR ( I CO ) . GE . TP 1 . AND . OPR ( I CO ) . LE . TP2 )  THEN 
WRITE (15,*) 

WRITE(15,*)  'WSORT:  Weapons  sorted  by  requirements  they  meet...' 
WRITE (15,*) 

WRITE (15,*)  'Target  Num  Mob  Time  DE  Pri' 

WRITE(15,2200) 

WRITE(15,2100)  T0BJ(IC0),TG0F0R(IC0),M0BT(IC0),CTUR(TUR(IC0)), 

+  ODE1(ICO),OPR(ICO) 

WRITE(15,2200) 

WRITE (15,*)  '  DE  ', 

+  '  ' 

,WRITE(15,*)  'Weapons  Num  Mob  Time  Alert  Met?  DE  ', 

+  'Pri  Allowed?' 

WRITE (15, 2200) 

N  =  0 

DO  300  I  =  1,2 
DO  300  J  =  1,3 
DO  300  K  =  1,2 
DO  300  L  =  1,2 

IF(ISDE(I,J,K,L).EQ.O)  GO  TO  300 
DO  310  LL  =  1,ISDE(I,J,K,L) 

N  =  N  +  1 

WRITE(1S,2000)  WNAM(IDXSA(N)),AINV(ID.XSA(N)), 

+  (AWT(II,IDXSA(N)),II=1,4), 

+  DE(ICO,IDXSA(N)),WPR(IDXSA(N)),AWX(N) 

310  CONTINUE 
300  CONTINUE 

WRITE(15,2200) 

END  IF 
C 

C  Check  the  mobility,  timing  and  DE  requirements... 

CALL  REQMOB 
CALL  REQTIM 
CALL  REQDE 
C 

2000  F0RMAT(1X,A10,4X,I5,1X,A3,2(2X,A3),3X,A3,2X,F4.3,1X,I3,5X,A1) 
2100  F0RMAT(1X,A12,2X,I5,2X,A1,4X,A2,13X,F4.3,1X,I3) 

2200  FORMATC . ', 

+  ' . ') 

C 

RETURN 

C 


END 


SUBROUTINE  WSORTA 


c 

C  WSORTA  sorts  the  available  weapons  by  alert  rate.  If  no 
C  distinction  is  made  between  generated  and  day-to-day 
C  weapons,  IDXSA  remains  unchanged  and  an  'A'  (for  ALL) 

C  is  placed  in  the  appropriate  cell  of  AWT.  If  weapons  are 
C  differentiated  by  alert  rate,  day-to-day  weapons  are 
C  ordered  first  and  generated  weapons  second. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

CHARACTER*!  IWX(60) 

CHARACTER*2  CALRT 
CHARACTER* 10  CNAM 
C 

$  INCLUDE:  'AWEAPS.CDE' 

§  INCLUDE:  'OBJ.CDE' 

$INCLUDE:  ' RULES. CDE' 

$ INCLUDE:  'TARGT.CDE* 

$ INCLUDE:  'WEAPS.CDE* 

C 

DIMENSION  IW0RK(60) 

C 

C  Initialize  the  working  array... 

DO  10  I  =  1,NSALL 
IWX(I)  =  AWX(I) 

10  IWORK(I)  =  IDXSA(I) 

C 

C  If  no  distinction  exists  by  weapon  alert,  leave  lists 
C  inchanged. . . 

IFCARATE.EQ. 'D' .OR. (ARATE .EQ. 'G' .AND.AORDER.EQ. '2' ))  THEN 
DO  100  I  =  1,NSALL 
IDXSA(I)  =  IWORK(I) 

AWT(3,IDXSA(I))  =  'A  ' 

100  CONTINUE 

DO  110  I  =  1,2 
DO  no  J  =  1,3 

ISALT(I,J,1)  =  ISTIM(I,J) 

ISALT(I,J,2)  =  0 
no  CONTINUE 

GO  TO  1000 
ENDIF 
C 

N  =  0 

DO  200  I  =  1,2 
DO  200  J  =  1,3 
DO  200  K  =  1,2 
M  =  0 

CALRT  =  'd_’ 

IF(K.EQ.2)  CALRT  =  'g_' 

IF(ISTIN(I,J).EQ.O)  THEN 
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ISALr(I,J,K)  =  0 
GO  TO  200 
ENDIF 

DO  210  L  =  1,ISTIM(I,J) 

KO  =  L 

IF(I.GT.l)  KO  =  KO  +  ISMOB(l) 
IF(J.GT.l)  KO  =  KO  +  ISTIM(I,1) 
IF(J.GT.2)  KO  =  KO  +  ISTIM(I,2) 
CNAM  =  W^lAUdWORKCKO)) 
IF(CNAM(1:2).NE.CALRT)  GO  TO  210 
M  =  M  +  1 
N  =  N  +  1 

IDXSA(N)  =  IWORK(KO) 
AWT(3,IDXSA(N))  =  CALRT 
AWX(N)  =  HvX(KO) 

210  CONTINUE 

ISALTd.J.K)  =  M 
200  CONTINUE 
C 

1000  RETURN 
C 

END 


SUBROUTINE  WSORTD 


C 

C  WSORTD  sorts  the  available  weapons  by  DE.  Weapons  which 
C  do  meet  the  DE  requirement  for  the  objective  are  ordered 
C  first  and  a  'Y'  (for  YES,  they  do  meet  the  requirement)  is 
C  placed  into  the  appropriate  cell  of  AWT).  Weapons  which  do 
C  not  meet  the  requirement  are  ordered  second  and  an  'N'  (for 
C  NO,  does  not  meet  the  requirement)  is  placed  in  the  appropriate 
C  cell  of  AWT.  Note:  If  a  weapon  DE  is  less  than  the  min  DE  required 
C  for  allocation,  an  'N'  is  placed  in  AWT  and  that  weapon  is  not 
C  allowed  for  allocation. 

C 

IMPLICIT  INTEGER*4  (I-N) 

CHARACTER*!  IWX(60) 

C 

$ INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  'OBJ.CDE' 

$  INCLUDE:  ' RULES. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  IWORK(60) 

C 

C  Initialize  the  working  array... 

DO  10  I  =  1,NSALL 
IWX(I)  =  AWX(I) 

10  IWORK(I)  =  IDXSA(I) 

C 

C  Loop  through  the  weapons  which  are  already  sorted  by 
C  mobility  (1=1,2),  by  timing  (J=l,3),  alert  rate  (K=l,2), 

C  and  now  also  by  whether  or  not  the  DE  requirement  is  met... 

C 

N  =  0 

DO  200  I  =  1,2 
DO  200  J  -  1,3 
DO  200  K  =  1,2 
DO  200  1.  =  1,2 
M  =  0 

IF(ISALT(I,J,K).EQ.O)  THEN 
ISDE(I,J,K,L)  =  0 
GOTO  200 
END  IF 

DO  210  LL  =  1,ISALT(I,J,K) 

KO  =  LL 

IF(I.GT.l)  KO  =  KO  +  ISNOB(l) 

IF(J.GT.l)  KO  =  KO  +  ISTIMd.l) 

IF(J.GT.2)  KO  =  KO  +  ISTIM(I,2) 

IF(K.GT.l)  KO  =  KO  +  iSALT(I,J,l) 

DEX  =  DEdCO,IWORK(KO)) 

IF(L.EQ.l)  THEN 
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IF(DEX.LT.0DE1(IC0).0R.DEX.LT.DMIN(IC0))  GOTO  210 
M  =  M  +  1 
N  =  N  +  1 

IDXSA(N)  =  IWORK(KO) 

AWT(4,IDXSA(N))  =  'Y  ' 

ELSE 

IF(DEX.GE.ODEl(ICO).AND.DEX.GE.DMIN(ICO))  GOTO  210 
M  =  M  +  1 
N  =  N  +  1 

IDXSA(N)  =  IWORK(KO) 

AWT(4,IDXSA(N))  =  'N  ' 

IFCARDE.EQ. .OR.DEX.lt. DMIN(ICO))  AWX(N)  =  'N' 
ENDIF 
210  CONTINUE 

ISDE(I,J,K,L)  =  M 
200  CONTINUE 
C 

1000  RETURN 
C 

END 


SUBROUTINE  WSORTL(IDLOW) 

c 

C  WSORTL  sorts  the  available  weapons  by  weapon  leg.  Weapons  of  different 
C  legs  than  those  allocated  in  the  first  pass  are  sorted  first,  then 
C  weapons  of  the  same  leg,  different  weapons,  then  the  same  weapon. 

C  This  sorting  also  accounts  for  pr 1 -dependency .  (This  subroutine  uses 
C  the  same  arrays  as  those  used  by  WSORTT. )  IDLOW  is  the  index  of  the 
C  current  objective. 

C 

IMPLICIT  INTEGER*4  (I-N) 

C 

CHARACTER*!  IWX(60) 

CHARACTER* 10  CNAM , CNAM2 
C 

$ INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'AWEAPS.CDE' 

$  INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'TARGT.CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  IW0RK(60) 

C 

C  Initialize  the  working  array... 

DO  10  I  =  l.NSALL 
IWX(I)  =  AWX(I) 

10  IWORK(I)  =  IDXSA(I) 

C 

IDX2  =  AWTYPdDLOW,!) 

IF(IDX2.EQ.O)  IDX2  =  AWTYP(IDL0W,2) 

C 

L  =  0 

DO  200  I  =  1,2 
DO  100  J  =  1,3 
M  =  0 

!F(ISM0B(I).EQ.0)  THEN 
ISTIM(I,J)  =  0 
GO  TO  100 
END  IF 

DO  110  K  =  l.ISMOBd) 

LO  =  K 

IFCI.GT.l)  LO  =  K  +  ISMOB(l) 

CNAM  =  WNAM(IW0RK(L0)) 

CNAM2  =  WNAMdDX2) 

IF(J.EQ.l.AND.WLEGdW0RK(L0)).EQ.WLEGdDX2))  GOTO  110 
IF(J.EQ.2)  THEN 

IF  (WLEG  ( I  WORK  (  LO ) )  .  NE .  WLEG  dDX2  )  .  OR . 

+  CNAM(2:10).EQ.CNAM2(2:10))  GOTO  110 

END  IF 

IF(J.EQ.3)  THEN 

IF(CNAN(2:10).NE.CNAM2(2:10))  GOTO  110 
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ENDIF 
M  =  M  +  1 
L  =  L  +  1 

IDXSA(L)  =  IWORK(LO) 

AWT(2,IDXSA(L))  =  WLEG(IDXSA(L)) 

AWX(L)  =  IWX(LO) 

IF(J.GT.l.AND.ARLEG.EQ.'l')  AWX(L)  =  ’N' 
IF(J.EQ.3.AND.ARSAM.EQ.'l')  AWX(L)  =  'N' 
110  CONTINUE 

ISTIMd.J)  =  M 
100  CONTINUE 
200  CONTINUE 


C 


RETURN 

END 
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SUBROUTINE  WSORTM 

C 

C  WSORTM  sorts  the  available  weapons  by  mobility.  For  mobile 
C  targets,  mobile  capable  weapons  are  sorted  before  non-mobile 
C  ones;  for  non-mobile  targets,  the  reverse  is  true. 

C 

IMPLICIT  INTEGER*^  (I-N) 

C 

CHARACTER*!  ARULE 
CHARACTER*2  CM0B(2) 

C 

$ INCLUDE:  'AWEAPS.CDE' 

$  INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  IW0RK(60) 

C 

C  Initlali;io  the  arrays  used  for  comparisons... 

CMOB(l)  =  '  ' 

CM0B(2)  =  'M' 

ARULE  =  ARMOF 
IF(M0BT(IC0).EQ. 'M')  THEN 
CMOB(l)  =  'M' 

CM0B(2)  =  '  ' 

ARULE  =  ARFOM 
ENDIF 
C 

C  Move  the  IDXSA  array  into  a  working  array  and  initialize  AWX  array. . 
DO  90  I  =  l.NSALL 
AWX(I)  =  'Y' 

90  IWORK(I)  =  IDXSA(I) 

C 

C  Loop  through  the  two  mobility  options... 

L  =  0 

DO  100  I  =  1,2 
M  =  0 

DO  110  J  =  l.NSALL 

1F(M0BW(IW0RK(J)).NE.CM0B(I))  GO  TO  110 
M  =  M  +  1 
L  =  L  +  1 

IDXSA(L)  =  IWORK(J) 

AWT(1,ID.XSA(L))  =  CMOB(I) 

IF(CM0B(I).EQ. '  ')  AWT(1,IDXSA(L))  =  'F  ' 
IF(I.EQ.2.AND.ARULE.EQ. '1')  AWX(L)  =  'N' 

110  CONTINUE 

ISMOB(I)  =  M 
100  CONTINUE 
C 

RETURN 


o  o  o  o  o 


SUBROUTINE  WSORTP 


C 

C  WSORTP  prioritizes  the  available  weapons  by  input  priority 
C  order.  Specifically,  for  each  group  of  weapons  which  do  meet 
C  the  DE  requirement,  these  weapons  are  ordered  from  highest 
C  to  lowest  input  priority  order,  and  similarly  for  weapons 
C  which  do  not  meet  the  DE. 

C 

IMPLICIT  INTEGERS  (I-N) 

CHARACTER*!  IWX(60) 

C 

$ INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

§ INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  IWORK(60) 

Loop  through  the  weapons  which  are  already  sorted  by 
mobility  (1=1,2),  by  timing  (J=l,3),  alert  rate  (K=l,2), 
and  DE  (L=l,2). 

N  =  0 

DO  200  I  =  1,2 
DO  200  J  =  1,3 
DO  200  K  =  1,2 
DO  200  L  =  1,2 

IF(ISDE(I,J,K,L).LE.l)  GOTO  200 
C 

C  Initialize  the  working  array... 

DO  210  LL  =  1,ISDE(I,J,K,L) 

LO  =  LL 

IF(I.GT.l)  LO  =  LO  +  ISMOB(l) 

IF(J.GT.l)  LO  =  LO  +  ISTIM(I,1) 

IF(J.GT.2)  LO  =  LO  +  ISTIM(I,2) 

IF(K.GT.l)  LO  =  LO  +  ISALT(I,J,1) 

IF(L.GT.l)  LO  =  LO  +  ISDE(I ,J,K, 1) 

IWORK(LL)  =  IDXSA(LO) 

IWX(LL)  =  AWX(LO) 

210  CONTINUE 

C  Sort  from  greatest  priority  to  least,  using  a  bubble  sort.. 
DO  220  JJ  =  1,ISDE(I,J,K,L)-1 
DO  220  KK  =  JJ+1,ISDE(I,J,K,L) 

IF(WPR(IWORK(KK)).GT.WPR(IWORK(JJ)))  GO  TO  220 
TEMP  =  IWORK(KK) 

IWORK(KK)  =  IWORK(JJ) 

IWORK(JJ)  =  TEMP 
220  CONTINUE 

Reset  the  IDXSA  array... 

DO  230  LL  =  1,ISDE(I,J,K,L) 


C 
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230 

C 


LO  =  LL 


IF(I.GT.l)  LO  =  LO  + 

IF(J.GT.l)  LO  =  LO  + 

IF(J.GT.2)  LO  =  LO  + 

IF(K.GT.l)  LO  =  LO  + 

IF(L.GT.l)  LO  =  LO  + 

IDXSA(LO)  =  IWORK(LL) 
AWX(LO)  =  IWX(LL) 
CONTINUE 


ISMOB(l) 

ISTIMd.l) 

ISTIM(I,2) 

ISALT(I,J,1) 

ISDE(I,J,K,1) 


200  CONTINUE 
C 


1000  RETURN 
C 

END 
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SUBROUTINE  WSORTT(IP) 

c 

C  WSORTT  sorts  the  available  weapons  by  time  urgency. 

C  For  TU  targets  weapons  are  sorted  as  time  urgent, 

C  time  sensitive,  non-time  sensitive;  for  time  sensitive  targets 
C  weapons  are  sorted  as  time  sensitive,  time  urgent  and  non-time 
C  sensitive;  and  for  non-time  sensitive  targets,  weapons 
C  are  sorted  as  non-time-sensitive,  time  sensitive  and  time  urgent. 

C  IP  tells  which  Pass  is  active  (1  or  2). 

C 

IMPLICIT  INTEGERS  (I-N) 

C 

CHARACTER*!  IWX(60) 

CHARACTER*2  CTIM(3) 

C 

$ INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  ' WE APS. CDE' 

C 

DIMENSION  IWORK(60) 

DIMENSION  IC0MP(3) 

C 

C  If  weapons  are  to  be  sorted  by  whether  or  not  they  meet 
C  the  time  urgency  requirement  (TS0RT='l'in  Pass  1  or 
C  TLS0RT='l'  in  I  -  5  2)  call  WSRTT2... 

IF((IP.EQ.1.AND.TS0RT.EQ. 'l').0R.(IP.EQ.2.AND. 

+  TLSORT.EQ. '1'))  THEN 
CALL  WSRTT2 
RETURN 
END  IF 
C 

C  If  weapons  are  to  recieve  no  additional  sorting,  prepare  the  AWT(2,I) 
C  and  AWX(I)  arrays,  as  appropriate... 

IFdP.EQ. 2. AND. TLSORT.EQ.  '2')  THEN 
CTIM(l)  =  'TU' 

CTIM(2)  =  'TS' 

CTIM(3)  =  'NT' 

DO  5  I  =  1,2 

ISTIM(I,1)  =  ISMOB(I) 

ISTIM(I,2)  =  0 
ISTIM(I,3)  =  0 
IF(ISMOB(I).EQ.O)  GOTO  5 
DO  7  K  =  l.ISMOBd) 

LO  =  K 

IF(I.GT.l)  LO  =  K  +  ISMOB(l) 

AWT(2,L0)  =  CTIM(WTUdDXSA(LO))) 
IF(WTU(IDXSA(LO)).GT.TURdCO).AND.ARTU.EQ.  '1') 

+  AWX(LO)  =  'N' 

7  CONTINUE 
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5  CONTINUE 
RETURN 
ENDIF 
C 

C  Initialize  the  working  array... 

DO  10  I  =  l.NSALL 
IWX(I)  =  AWX(I) 

10  IWORK(I)  =  IDXSA(I) 

C 

C  Set  up  the  comparison  arrays  for  each  case  of  objective  time 
C  urgency  requirement... 

IF(TUR(ICO).EQ.l)  THEN 
CTIM(l)  =  'TU' 

CTIM(2)  =  'TS' 

CTIM(3)  =  'NT' 

DO  50  I  =  1,3 
50  ICOMP(I)  =  I 

ENDIF 
C 

IF(TUR(IC0).EQ.2)  THEN 
CTIM(l)  =  'TS' 

CTIM(2)  =  'TU' 

CTIM(3)  =  'NT' 

ICOMP(l)  =  2 
IC0MP(2)  =  1 
IC0MP(3)  =  3 
ENDIF 
C 

IF(TUR(ICO).EQ.3)  THEN 
CTIM(l)  =  'NT' 

CTIM(2)  =  'TS' 

CTIM(3)  =  'TU' 

DO  60  I  =  1,3 
60  ICOMP(I)  =  A  -  I 

ENDIF 
C 

L  =  0 

DO  100  I  =  1,2 

DO  100  J  =  1,3 

M  =  0 

IF(ISMOB(I).EQ.O)  THEN 
ISTIMd.J)  =  0 
GO  TO  100 
ENDIF 

DO  no  K  =  l,ISMOB(I) 

LO  =  K 

IF(I.GT.l)  LO  =  K  +  ISMOB(l) 
IF(WTU(IWORK(LO)).NE.ICOMP(J))  GO  TO  110 
M  =  M  +  1 

L  =  L  +  1 

IDXSA(L)  =  IWORK(LO) 
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AWT(2,IDXSA(L))  =  CTIM(J) 

AWX(L)  =  IWX(LO) 

IF(J.GT.1.AND.IC0MP(J).GT.IC0MP(1) 
+  .AND.ARTU.EQ. '1')  AWX(L)  =  'N' 
no  CONTINUE 

ISTIMd.J)  =  M 
100  CONTINUE 

RETURN 


C 


END 
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C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE  WSORT2(IDLOW,DEREQ) 

WS0RT2  sorts  all  available  weapons  for  the  Pass  2  allocations. 

IDLOW  is  the  index  of  the  current  allocation.  DEREQ  is  the  weapon- 
per-target  DE  required  to  meet  the  goal  DE.  Options  for  sorting  are: 
Mobility  -  for  mobile  targets,  mobile  capable 

weapons  are  sorted  before  non-mobile  ones; 
for  non-mobile  targets,  the  reverse  is  true. 

Leg  &  PRL  -  Weapons  are  sorted  with  respect  to  the  weapon 
Dependency/  allocated  in  Pass  1  for  this  subset.  Weapons  of 
Timing  opposite  legs  are  sorted  first,  then  weapons  of 

the  same  leg  and  finally  the  same  weapon. 

(For  weapons  NOT  TARGETED  in  Passl  or  if  the  user  has 
otherwise  chosen  weapons  are  sorted  by  timing.) 

Alert  rate  -  If  weapons  are  distinguished  as  day-to-day  or  generated, 
and  if  the  first  Pass  allocation  used  a  generated  weapon, 
day-to-day  weapons  for  the  second  pass  are  ordered  first, 
then  generated  weapons  are  ordered.  If  no  distinction  is 
made,  no  unique  ordering  by  alert  rate  is  made.  (For 
weapons  NOT  TARGETED  in  Pass  1,  sort  by  original  alert 
rate  ordering.) 

DE  Requirement  -  weapons  which  meet  the  current  target  objective 

DE  (the  joint  weapon  per  target  DE  for  the  current 
weapon  of  Pass  2  in  conjunction  with  the  weapon 
allocated  in  Pass  1)  are  ordered  before  those  which 
do  not. 

Priority  -  weapons  are  finally  sorted  by  priority. 

IMPLICIT  INTEGER*4(I-N) 

CHARACTER*!  ATIM(60) 

CHARACTER*2  CNAM,CTUR(3) 

CHARACTER* 10  CCNAM 


C 

$  INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'AWE APS. CDE' 

$ INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'TARGT.CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

DATA  CTUR  /'TU' , 'TS' , 'NT'/ 

C 

C  Set  IPl:  set  to  1  if  this  allocation  subset  does  not  already 
C  have  at  least  one  weapon  allocated... 

IPl  =  0 


IF(AWTYP(IDL0W,1).EQ.0.AND.AWTYP(IDL0W,2).EQ.0)  IPl  =  1 
C  Sort  the  weapons  by  mobility... 

CALL  WSORTM 
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C 

C  Sort  the  mobility-sorted  weapons  by  time  urgency  or  triad  leg... 
IFCIPl.EQ.l.OR.TLSORT.NE. '3')  THEN 
CALL  WS0RTT(2) 

ELSE 

CALL  WSORTL(IDLOW) 

ENDIF 

C 

C  Sort  the  mobility-  and  timing/ leg-sorted  weapons  by  alert  rate... 
IF(IPl.EQ.l)  THEN 
CALL  WSORTA 
ELSE 

CALL  WSRTA2(IDL0W) 

ENDIF 

C 

C  Sort  the  mobility-,  timing/leg-  and  alert-sorted  weapons  by  DE... 
IF(IPl.EQ.l)  THEN 
CALL  WSORTD 
ELSE 

CALL  WSRTD2(IDL0W,DEREQ) 

ENDIF 

C 

C  Sort  the  mobility,  time/leg-,  alert-  and  DE-sorted  weapons  by  priority; 
C  If  final  priority  is  by  DE,  call  WSPRDE  (P0RDER=1).  If  priority  is 
C  by  user  input  priority,  call  WSORTP  (P0RDER=2). 

IF(PORDER.EQ.'l')  THEN 
IF(IPl.EQ.l)  THEN 
CALL  WSPRDE 
ELSE 

CALL  WSPDE2(IDL0W) 

ENDIF 

ELSE 

CALL  VSORTP 
ENDIF 
C 

C  Write  all  this  stuff  out... (I  is  the  mobility  loop,  J  is  the  leg/prl 
C  dependency  loop,  K  is  the  alert  rate  loop  and  L  is  the  DE  loop...) 

N  =  0 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
WRITE (15,*) 

WRITE(1: ,*)  ’WS0RT2:  Weapons  sorted  by  requirements  they  meet:' 
WRITE(15,*) 

WRITEdS,*)  ‘Target  Num  Mob  Time  DE  Pri' 

WRITE(15,2200) 

WRITEdS  ,2100)  TOBJdCO)  .TGOFORdCO)  .MOBTCICO)  ,CTUR(TURdCO) ) , 

+  0DEldC0),0PRdC0) 

WRITEdS, 2200) 

ENDIF 

C 

C  Set  IDX..,  the  index  of  the  first  weapon  allocated... 

IFdPl.FQ.l)  THEN 
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IDX2  =  0 
GOTO  200 
ELSE 

IDX2  =  AWTYPdDLOW.l) 

IF(IDX2.EQ.O)  IDX2  =  AWTYP(IDL0W,2) 

ENDIF 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
WRITEdS,*)  'Passl  Weapon 
IF(TLSORT.EQ. '3')  THEN 


WRITEdS,*) 

ELSE 

'  Allocated 

Num  Mob 

Leg 

Alert 

DE 

Pri 

WRITEdS,*) 

ENDIF 

'  Allocated 

Num  Mob 

Time 

Alert 

DE 

Pri 

WRITE (IS, 2200) 

CCNAM  =  WNAM(IDX2) 

CNAM  =  CCNAM(1:2) 

IFCCNAM.NE. 'd_' .AND.CNAM.NE.V)  CNAM  =  '  ' 

IF(TLSORT.EQ. '3')  THEN 

WRITE ( 15 , 20 IS )  CCNAM , ATNUM ( IDLOW) , MOBW ( IDX2 ) , WLEG ( IDX2 ) , 

+  CNAM,DE(ICO,IDX2),WPR(IDX2) 

ELSE 

WRITE ( 15 , 2020 )  CCNAM , ATNUM ( IDLOW) , MOBW ( IDX2 ) , CTUR (WTU ( IDX2 ) ) , 

+  CNAM,DE(ICO,IDX2),WPR(IDX2) 

ENDIF 

WRITE(15,2200) 

ENDIF 

C 

200  IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
IFdPl.EQ.l.OR.TLSORT.NE.  '3')  THEN 

WRITE (15,*)  '  DE  ', 

+  '  ' 

WRITEdS,*)  'Weapons  Nutn  Mob  Time  Alert  Met?  DE', 

+  '  Pri  Allowed?’ 

ELSE 

WRITEdS,*)  '  DE  ', 

+  '  Time  ' 

WRITEdS,*)  'Weapons  Num  Mob  Leg  Alert  Met?  DE', 

+  '  Pri  Met?  Allowed?' 

ENDIF 

I F (I PR I NT . NE . 0 . AND . OPR (ICO) . GE . TP 1 . AND . OPR (ICO ) . LE . TP2 ) 

+  WRITEdS, 2200) 

ENDIF 
N  =  0 

DO  300  I  =  1,2 
DO  300  J  =  1,3 
DO  300  K  =  1,2 
DO  300  L  =  1,2 

IFdSDEd,J,K,L).EQ.O)  GO  TO  300 
DO  310  LL  =  1,ISDE(I,J,K,L) 

N=  N  +  1 


IF(IDX2.EQ.O)  THEN 

DEX  =  DE(ICO,IDXSA(N)) 

ELSE 

DEX  =  l.-(l.-DE(IC0.IDXSA(N)))*(l.-DE(IC0,IDX2)) 

ENDIF 

C  Do  a  final  check  on  timing. . . 

IF(IPl.NE.l)  THEN 
ATIM(N)  -•  'Y' 

IF(WTU(IDXSA(N)).GT.TUR(ICO))  THEN 
ATIM(N)  =  'N' 

IF(ARTU.EQ.'l')  AWX(N)  =  ’N' 

ENDIF 

ENDIF 

C 

IF ( IPRINT . NE . 0 . AND . OPR ( ICO) . GE , TP 1 . AND . OPR ( ICO) . LE . TP2 )  THEN 
IF ( I P 1 . EQ . 1 . OR . TLSORT . NE . ' 3 ' )  THEN 
WRITE (15, 2000)  WNAM(IDXSA(N)) .AINV(IDXSA(N)) , 

+  (AWTCII ,IDXSA(N)) ,11=1,4) ,DEX,WPR(IDXSA(N)) ,AWX(N) 

ELSE 

WRITE (15,2010)  WNAM ( IDXSA(N) ) , AINV ( IDXSA (N) ) , 

+  (AWT(II,IDXSA(N)),II=1,4),DEX,WPR(IDXSA(N)),ATIM(N),AWX(N) 

ENDIF 
ENDIF 
310  CONTINUE 
300  CONTINUE 

IF(IPRINT.NE.O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2) 

+  WRITE (15, 2200) 

C 

C  Check  the  mobility,  time*urgency  (or  leg)  and  DE... 

CALL  REQMOB 

IF(IP1.EQ.1.0R.TLS0RT.NE.'3’)  THEN 
CALL  REQTIM 
ELSE 

CALL  REQLEG(IDLOW) 

ENDIF 

IF(IPl.EQ.l)  CALL  REQDE 
IF(IPl.NE.l)  CALL  REQDE2(IPLOW) 

C 

2000  F0RMAT(1X,A10,4X,I5,1X,A3,2(2X,A3),3X,A3,2X,F4.3,1X,I3,5X,A1) 
2010  F0RMAT(1X,A10,4X,I5,1X,A3,2(2X,A3),3X,A3,2X,F4.3,1X,I3,4X,A1, 

+  5X,A1) 

2100  F0RMAT(1X.A12,2X,I5,2X,A1,4X,A2,13X,F4.3,1X,I3) 

2015  F0RMAT(1X.A10,4X,I5,1X,A2,2X,A3,3X,A3,8X,F4.3,1X,I3) 

2020  F0RMAT(1X,A10,4X,I5,1X,A2,4X,A2,2X,A3,8X,F4.3,1X,I3) 

2200  FORMAT (' . ', 

+  ' . ') 

C 

RETURN 

C 


SUBROUTINE  WSPDE2(  IDLOW) 


c 

C  WSPDE2  prioritizes  the  available  weapons  by  DE  for  Pass  2.  Specifically, 
C  for  each  group  of  weapon  (pairs)  which  do  meet  the  DE  requirement, 

C  these  weapons  are  ordered  from  lowest  to  highest  DE,  so  that 
C  a  weapon  which  meets,  but  least  exceeds  the  DE  is  selected. 

C  For  weapons  which  do  not  meet  the  DE,  these  are  ordered  from 
C  highest  to  lowest  DE  so  that  a  weapon  which  comes  closest  to 
C  meeting  the  DE  will  be  chosen  (if  no  weapons  which  do  meet 
C  the  DE  can  be  chosen).  IDLOW  is  the  index  of  the  current  allocation. 

C 

IMPLICIT  INTEGER*4  (I-N) 

CHARACTER*!  IWX(60) 

C 

$INCLUDE:  'ALLOC. CDE' 

$ INCLUDE:  'AWEAPS.CDE' 

$INCLUDE:  'OBJ. CDE' 

$ INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  IWORK(60) 

C 

C  Loop  through  the  weapons  which  are  already  sorted  by 
C  mobility  (1=1,2),  by  leg  (J»l,3),  alert  rate  (K=l,2), 

C  and  DE  (LSI, 2). 

C 

IDX2  »  AWTYP(IDL0W,1) 

IF(IDX2.EQ.O)  IDX2  =  AWTYP(IDL0W,2) 

C 

C  Calculate  the  additional  weapon  per  target  DE  required 
DEREQ  =  1.  -  (l.-0DEl(IC0))/(l.-DE(IC0,IDX2)) 

C 

N  =  0 

DO  200  I  =  1,2 
DO  200  J  =  1.3 
DO  200  K  =1.2 
DO  200  L  =  1,2 

IF(ISDE(I,J,K,L).LE.l)  GOTO  200 
C 

C  Initialize  the  working  array... 

DO  210  LL  =  1,ISDE(I.J,K,L) 

LO  =  LL 

IF(I.GT.l)  LO  =  LO  +  ISMOB(l) 

IF(J.GT.l)  LO  =  LO  +  ISTIMd.l) 

IF(J.GT.2)  LO  =  LO  +  ISTIM(I,2) 

IF(K.GT.l)  LO  =  LO  +  ISALT(I,J,1) 

IF(L.GT.l)  LO  =  LO  +  ISDE(I,J,K. 1) 

IWORK(LL)  =  IDXSA(LO) 

IWX(LL)  =  AWX(LO) 
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210  CONTINUE 

C  Sort  from  lowest  to  highest  DE  or  from  highest  to  lowest  DE  depending 

C  on  whether  these  weapons  do  or  do  not  meet  the  required  DE . . . 

DO  220  JJ  =  1,ISDE(I,J,K,L)-1 
DO  220  KK  =  JJ+1,ISDE(I,J,K,L) 

IF (DE ( ICO . IWORK (KK) ) . GE . DEREQ)  THEN 

IF(DE(ICO,IWORK(KK)).GT.DE(ICO,IWORK(JJ)))  GO  TO  220 
IF (DE ( ICO , IWORK (KK) ) . EQ . DE ( ICO , IWORK ( JJ) ) . AND . 

+  WPR(IWORK(KK)).GT.WPR(IWORK(JJ)))  GOTO  220 

TEMP  =  IWORK (KK) 

IWORK(KK)  =  IWORK(JJ) 

IWORK (JJ)  =  TEMP 
ELSE 

IF(DE(ICO,IWORK(KK)).LT.DE(ICO,IWORK(JJ)))  GO  TO  220 
IF (DE ( ICO , IWORK (KK) ) . EQ . DE ( ICO , IWORK (JJ) ) . AND . 

+  WPR(IWORK(KK)).GT.WPR(.WORK(JJ)))  GOTO  220 

TEMP  =  IWORK (KK) 

IWORK(KK)  =  IWORK(JJ) 

IWORK(JJ)  =  TEMP 
ENDIF 
220  CONTINUE 

C  Reset  the  IDXSA  array... 

DO  230  LL  =  1,ISDE(I,J,K,L) 

LO  =  LL 

IF(I.GT.l)  LO  »  LO  +  ISMOB(l) 

IF(J.GT.l)  LO  «  LO  +  ISTIMd.l) 

IF(J.GT.2)  LO  =  LO  +  ISTIM(I,2) 

IF(K.GT.l)  LO  *  LO  +  ISALT(I,J,1) 

IF(L.GT.l)  LO  =  LO  +  ISDE(I ,J,K, 1) 

IDXSA(LO)  =  IWORK(LL) 

AWX(LO)  =  IWX(LL) 

230  CONTINUE 
C 

200  CONTINUE 
C 

1000  RETURN 
C 


END 


SUBROUTINE  WSPRDE 


C 

C  WSPRDE  prioritizes  the  available  weapons  by  DE.  Specifically, 

C  for  each  group  of  weapons  which  do  meet  the  DE  requirement, 

C  these  weapons  are  ordered  from  lowest  to  highest  DE,  so  that 
C  a  weapon  which  meets,  but  least  exceeds  the  DE  is  selected. 

C  For  weapons  which  do  not  meet  the  DE,  these  are  ordered  from 
C  highest  to  lowest  DE  so  that  a  weapon  which  comes  closest  to 
C  meeting  the  DE  will  be  chosen  (if  no  weapons  which  do  meet 
C  the  DE  can  be  chosen) . 

C 

IMPLICIT  INTEGER*4  (I-N) 

CHARACTER*!  IWX(60) 

C 

$ INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' RULES. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  IWORK(60) 

C 

C  Loop  through  the  weapons  which  are  already  sorted  by 
C  mobility  (I»l,2),  by  timing  (J»l,3),  alert  rate  (K=l,2), 

C  and  DE  (L=l,2). 

C 

N  =  0 

DO  200  I  =  1,2 
DO  200  J  =  1,3 
DO  200  K  =  1,2 
DO  200  L  =  1,2 

IF(ISDE(I.J.K,L).LE.l)  GOTO  200 
C 

C  Initialize  the  working  array... 

DO  210  LL  =  1,ISDE(I,J,K,L) 

LO  =  LL 

IF(I.GT.l)  LO  =  LO  +  ISMOB(l) 

IF(J.GT.l)  LO  =  LO  +  ISTIMd.l) 

IF(J.GT.2)  LO  =  LO  +  ISTIM(I,2) 

IF(K.GT.l)  LO  =  LO  +  ISALT(I,J,1) 

IF(L.GT.l)  LO  =  LO  +  ISDE(I ,J,K, 1) 

IWX(LL)  =  AWX(LO) 

IWORK(LL)  =  IDXSA(LO) 

210  CONTINUE 

C  Sort  from  lowest  to  highest  DE  or  from  highest  to  lowest  DE  depending 

C  on  whether  these  weapons  do  or  do  not  meet  the  required  DE... 

DO  220  JJ  =  1,ISDE(I,J,K,L)-1 
DO  220  KK  =  JJ+1,ISDE(I,J,K,L) 

IF(DE(ICO.IWORK(KK)).GE.ODE1(ICO))  THEN 

IF(DE(IC0,IW0RK(KK)).GT.DE(IC0,IW0RK(JJ)))  GO  TO  220 
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IF(DE(ICO,IWORK(KK)).EQ.DE(ICO,IWORK(JJ)).AND. 

+  WPR(IWORK(KK)).GT.WPR(IWORK(JJ)))  GOTO  220 

TEMP  =  IWORK(KK) 

IWORK(KK)  =  IWORK(JJ) 

IWORK(JJ)  =  TEMP 
ELSE 

IF(DE(ICO,IWORK(KK)).LT.DE(ICO,IWORK(JJ)))  GO  TO  220 
IF (DE ( ICO , I WORK (KK) ) . EQ . DE ( ICO , IWORK ( JJ) ) . AND . 

+  WPR(IWORK(KK)).GT.WPR(IWORK(JJ)))  GOTO  220 

TEMP  =  IWORK (KK) 

IWORK (KK)  =  IWORK (JJ) 

IWORK(JJ)  =  TEMP 
END  IF 
220  CONTINUE 

C  Reset  the  IDXSA  array... 

DO  230  LL  =  1,ISDE(I,J,K,L) 

LO  =  LL 

IF(I.GT.l)  LO  =  LO  +  ISMOB(l) 

IF(J.GT.l)  LO  =  LO  +  ISTIMd.l) 

IF(J.GT.2)  LO  =  LO  +  ISTIM(I,2) 

IF(K.GT.l)  LO  =  LO  +  ISALT(I,J,1) 

IF(L.GT.l)  LO  =  LO  +  ISDE(I , J,K, 1) 

IDXSA (LO)  =  IWORK (LL) 

AWX(LO)  =  IWX(LL) 

230  CONTINUE 
C 

200  CONTINUE 
C 

1000  RETURN 
C 


END 


516  - 


SUBROUTINE  WSRTA2( IDLOW) 

c 

C  WSRTA2  sorts  the  available  weapons  by  alert  rate  for  Pass  2. 
C  If  no  distinction  is  made  between  generated  and  day-to-day 
C  weapons,  or  if  alert  distinction  is  made  and  a  day-to-day 
C  weapon  was  allocated  in  Pass  1  IDXSA  remains  unchanged  and 
C  an  'A'  (for  ALL)  is  placed  in  the  appropriate  cell  of  AWT. 

C  If  weapons  are  differentiated  by  alert  rate,  and  a  generated 
C  weapon  has  been  allocated  in  Pass  1,  day-to-day  weapons  or 
C  ordered  first.  IDLOW  is  the  index  of  the  current  allocation. 
C 

IMPLICIT  INTEGER*4  (I-N) 

C 

CHARACTER*!  IWX(60) 

CHARACTER*2  CALRT,CCOMP 
CHARACTER* 10  CNAM 
C 

$ INCLUDE:  ' ALLOC. CDE’ 

$  INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$  INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  IWORK(60) 

C 

C  Initialize  the  working  array... 

DO  10  I  a  1,NSALL 
IWX(I)  =  AWX(I) 

10  IWORK(I)  =  IDXSA(I) 

C 

IDX2  =  AWTYP (IDLOW, 1) 

IF(IDX2.EQ.O)  IDX2  =  AWTYP (IDLOW, 2) 

CNAM  =  WNAM(IDX2) 

CCOMP  =  CNAM(1:2) 

C 

C  If  no  distinction  exists  by  weapon  alert,  or  if  a  day-to- 
C  day  weapon  was  allocated  in  Pass  1,  leave  lists  unchanged... 
I F ( ARATE . EQ . ' D ' . OR . ( ARATE . EQ . ' G ' . AND . AORDER . EQ . ' 2 ' ) . OR . 

+  CCOMP. EQ. 'd_'  )  THEN 
DO  100  I  =  1,NSALL 
IDXSA(I)  =  IWORK(I) 

AWT(3,IDXSA(I))  =  'A  ' 

100  CONTINUE 

DO  110  I  =  1,2 

DO  no  J  =  1,3 

ISALT(I,J,1)  =  ISTIMd.J) 

ISALT(I,J,2)  =  0 
no  CONTINUE 

GO  TO  1000 
END  IF 


317 


C 

N  =  0 

DO  200  I  =  1,2 
DO  200  J  =  1,3 
DO  200  K  =  1,2 
M  =  0 

CALRT  =  'd_' 

IF(K.EQ.2)  CALRT  =  'g_’ 
IF(ISTIM(I,J).EQ.O)  THEN 
ISALT(I,J,K)  =  0 
GO  TO  200 
ENDIF 

DO  210  L  "  l.ISTIMd.J) 

KO  =  L 

IFd.GT.l)  KO  =  KO  +  ISMOB(l) 
IF(J.GT.l)  KO  =  KO  +  ISTIMd.l) 
IF(J.GT.2)  KO  =  KO  +  ISTIMd,2) 
CNAM  =  WNAMdWORK(KO)) 
IF(CNAM(1:2).NF.. CALRT)  GO  TO  210 
M  =  M  +  1 
N  =  N  +  1 

IDXSA(N)  =  IWORK(KO) 
AWT(3,IDXSA(N))  =  CALRT 
AWX(N)  =  IWX(KO) 

210  CONTINUE 

ISALTd.J.K)  =  M 
200  CONTINUE 
C 

1000  RETURN 
C 


END 
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SUBROUTINE  WSRTD2{IDLOW,DEREQ) 

c 

C  WSRTD2  sorts  the  available  weapons  for  Pass  2  by  DE.  Weapons,  which 
C  meet  the  DE  requirement  for  Pass  2  when  paired  with  weapons  already 
C  allocated  in  Pass  1  are  ordered  first  and  a  'Y*  (for  YES,  they  do 
C  meet  the  requirement)  is  placed  into  the  appropriate  cell  of  AWT). 

C  Weapons  which  do  not  meet  the  requirement  are  ordered  second  and  an 
C  'N'  (for  NO,  does  not  meet  the  requirement)  is  placed  in  the  appropriate 
C  cell  of  AWT.  An  'N'  is  also  placed  in  this  array  if  the  weapon  does 
C  not  meet  the  minimum  weapon  per  target  DE,  if  any,  specified  by  the  user 
C  in  the  targets  data  file.  IDLOW  is  the  index  of  the  current  allocation. 

C  DEREQ  is  the  weapon-per-target  DE  value  required  to  meet  the  DE  goal. 

C 

IMPLICIT  INTEGER*4  (I-N) 

CHARACTER*!  IWX(60) 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$  INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  'OBJ. CDE' 

$  INCLUDE:  'RULES. CDE' 

$  INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WE APS. CDE' 

C 

DIMENSION  IWORK(60) 

C 

C  Initialize  the  working  array... 

DO  10  I  =  1,NSALL 
IWX(I)  =  AWX(I) 

10  IWORK(I)  =  IDXSA(I) 

C 

C  Loop  through  the  weapons  which  are  already  sorted  by 
C  mobility  (1=1,2),  by  timing  (J=l,3),  alert  rate  (K=l,2), 

C  and  now  also  by  whether  or  not  the  DE  requirement  is  met... 

C 

IDX2  =  AWTYP ( IDLOW, 1) 

IF(IDX2.EQ.O)  IDX2  =  AWTYP (IDLOW, 2) 

C 

N  =  0 

DO  200  I  =  1,2 
DO  200  J  =  1,3 
DO  200  K  =  1,2 
DO  200  L  =  1,2 
M  =  0 

IF(ISALT(I,J,K).EQ.O)  THEN 
ISDE(I,J,K,L)  =  0 
GOTO  200 
ENDIF 

DO  210  LL  =  1,ISALT(I,J,K) 

KO  =  LL 

IF(I.GT.l)  KO  =  KO  +  ISMOB(l) 
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IF(J.GT.l)  KO  =  KO  +  ISTIMd.l) 

IF(J.GT.2)  KO  =  KO  +  ISTIM(I,2) 

IF(K.GT.l)  KO  =  KO  +  ISALT(I,J,1) 

DEX  =  DE(ICO,IWORK(KO)) 

IF(L.EQ.l)  THEN 

IF(DEX.LT.DEREQ.OR.DEX.LT.DMIN(ICO))  GOTO  210 
M  =  M  +  1 
N  =  N  +  1 

IDXSA(N)  =  IWORK(KO) 

AWT(A,IDXSA(N))  =  'Y  ' 

ELSE 

IF(DEX.GE.DEREQ.AND.DEX.GE.DMIN(ICO))  GOTO  210 
M  =  M  +  1 
N  =  N  +  1 

IDXSA(N)  =  IWORK(KO) 

AWT(4,IDXSA(N))  =  'N  ' 

IFCARDE.EQ. 'r.OR.DEX.LT.DMIN(ICO))  AWX(N)  =  'N' 
END  IF 
210  CONTINUE 

ISDEd.J.K.L)  =  M 
200  CONTINUE 
C 

1000  RETURN 
C 


END 
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SUBROUTINE  WSRTT2 


WSRTT2  sorts  the  available  weapons  by  time  urgency. 

Weapons  are  sorted  into  two  groups  only,  those  which 
meet  the  time  urgency  requirement,  and  those  which  don't. 

IMPLICIT  INTEGER*A  (I-N) 

CHARACTER*!  IWX(60) 

CHARACTER*2  CTIM(2) 

C 

$ INCLUDE:  'AWEAPS.CDE' 

$ INCLUDE:  'OBJ.CDE' 

$ INCLUDE:  ' RULES. CDE' 

$ INCLUDE:  'TARGT.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

DIMENSION  IW0RK(60) 

C 

C  Initialize  the  working  array... 

DO  10  I  =  1,NSALL 
IWX(I)  =  AWX(I) 

10  IWORK(I)  =  IDXSA(I) 

C 

CTIN(l)  =  '  y' 

CTIM(2)  =  '  N' 

C 

L  =  0 

DO  100  I  =  1,2 
ISTIM(I.3)  =  0 
DO  100  J  =  1,2 
M  =  0 

IF(ISMOB(I).EQ.O)  THEN 
ISTIMd.J)  =  0 
GO  TO  100 
ENDIF 

DO  no  K  =  l.ISMOB(I) 

LO  =  K 

IFd.GT.  1)  LO  =  K  +  ISMOB(l) 

IF(J.EQ.l.AND.WTUdWORK(LO)).GT.TURdCO))  GOTO  110 
IF(J.EQ.2.AND.WTUdW0RK(L0)).LE.TURdC0))  GO  TO  110 
M  =  M  +  1 
L  =  L  +  i 

IDXSA(L)  =  IWORK(LO) 

AWT(2,ID.XSA(L))  =  CTIM(J) 

AWX(L)  =  IWX(LO) 

I F ( J . EQ . 2 . AND . WTU ( I WORK ( LO) ) . GT . TUR (I CO ) . AND . ARTU . EQ . ' 1 ' ) 
+  AWX(L)  =  'N' 

no  CONTINUE 

ISTIMd.J)  =  M 
100  CONTINUE 
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C 

C 


RETURN 

END 
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SUBROUTINE  WUNHIT(IDLOW) 


WUNHIT  sets  the  allocation  of  weapons  to  targets  for 
targets  NOT  TARGETED  in  the  first  pass.  IDLOW  is  the 
index  of  the  current  allocation. 

IMPLICIT  INTEGER*4  (I-N) 

C 

$ INCLUDE:  ' ALLOC. CDE' 

$ INCLUDE:  ’AWEAPS.CDE' 

§ INCLUDE:  'OBJ. CDE' 

$INCLUDE:  'PRINT. CDE' 

$ INCLUDE:  'SSPKDE.CDE' 

$ INCLUDE:  'WEAPS.CDE' 

C 

C  Perform  initializations  as  needed. . . 

K  =  ICO 
II  =  IDLOW 

IF ( IPRINT . NE . 0 . AND . 0PR( ICO) . GE . TPl . AND . OPR ( ICO) . LE . TP2)  THEN 
WRITECIS,*)  'WUNHIT:  Number  of  Weapons  Available  for  ', 

+  'Allocation:  ' ,AINV(IUSE(1)) 

WRITE(15,*)  '  Number  of  Targets  requiring  a', 

+  '  Weapon  Allocation:  ' ,TG0F0R(IC0) 

TNDIF 

C 

C  If  the  new  allocation  has  enough  weapons  to  cover  the  subset, 

C  replace  the  old  NDXA  line;  otherwise  create  a  new  line  for 
C  targets  not  yet  hit  a  second  time... 

IF(NWA(1).GE.TG0F0R(IC0))  THEN 
C 

AWTYPCIl.l)  =  0 
AWTyP(Il,2)  =  lUSE(l) 

AWTYP(I1.3)  =  ICO 
ATNUM(Il)  =  TGOFOR(ICO) 

WPT(Il)  =  1 

DEAdl.ISC)  =  DE(K,IUSE{1)) 

CALL  SCNDE2(I1,DE(K,IUSE(1)),IUSE(1),0.,AWTYP(I1,2)) 

CALL  DNCALC 
DEI(Il)  =  DENEW(K) 

TGOFOR(K)  =  TGOFOR(K)  -  ATNUM(Il) 

C 

IF ( I PRINT . NE . 0 . AND . OPR ( ICOl . GE . TP 1 . AND . OPR ( ICO) . LE . TP2 )  THEN 
WRITECIS,*)  ■  The  old  DE  is:  ' ,DEOLD(K) 

WRITECIS,*)  '  The  new  DE  is:  ' ,DENEWCK) 

ENDIF 

DEOLDCK)  =  DENEWCK) 

AINVCIUSECD)  =  AINVCIUSECD)  -  ATNUMCIl) 

C 

ELSE 

C 

C  Case  where  target  subset  exceeds  inventory  of  selected  weapon. . . 


323  - 


C  Create  a  second  zeroed  line  for  'leftover*  targets... 

C 

CALL  ABUMP(Il) 

ATNUM(Il)  =  NWA(l) 

AWTYP(I1,1)  =  0 
AWTYP(I1,2)  =  lUSE(l) 

AWTYP(I1,3)  =  ICO 
WPT(Il)  =  1 

DEAdl.ISC)  =  DE(K,IUSE(1)) 

CALL  SCNDE2(I1,DE(K,IUSE(1)),IUSE(1),0.,AWTYP(I1,2)) 

CALL  DNCALC 
DEI (II)  =  DENEW(K) 

TGOFOR(K)  =  TGOFOR(K)  -  ATNUM(Il) 

C 

IF(IPRINT.NE.'O.AND.OPR(ICO).GE.TP1.AND.OPR(ICO).LE.TP2)  THEN 
WRITEdS,*)  '  The  old  DE  is;  ',DE0LD(K) 

WRITEdS,*)  '  The  new  DE  is:  ',DENEW(K) 

ENDIF 

DEOLD(K)  =  DENEW(K) 

AINVdUSE(l))  =  AINVCIUSEd))  -  NWACl) 

ENDIF 

C 

RETURN 

C 

END 
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